Theory System_Specification

section â¹System specificationâº

text â¹This section formalizes the CoCon system as an I/O automaton.
We call the inputs ``actions''.âº

theory System_Specification
imports Prelim
begin

subsection â¹System stateâº


text â¹The superuser of the system is called ``voronkov'',
as a form acknowledgement for our inspiration from EasyChair
when creating CoCon.
âº

record state =
  confIDs :: "confID list"
  conf :: "confID â conf"
  (*  *)
  userIDs :: "userID list"
  pass :: "userID â password"
  user :: "userID â user"
  roles :: "confID â userID â role list"
  (*  *)
  paperIDs :: "confID â paperID list"
  paper :: "paperID â paper"
  (*  *)
  pref :: "userID â paperID â preference" (* preference, including eventual conflicts *)
  (*  *)
  voronkov :: "userID"
  (*  *)
  news :: "confID â string list"
  phase :: "confID â phase" (* the current phase *)
  (*  *)


(* Note: Some of the fields are redundant, e.g., paperIDs can in principle be recovered from "roles";
however, this and other redundant fields are used very often, so it is efficient to keep them *)


(* Various discriminators ("is") and selectors ("get") on the database: *)
abbreviation isPC :: "state â confID â userID â bool" (*  program committee (PC) membership *) where
"isPC s confID uID â¡ PC ââ roles s confID uID"
abbreviation isChair :: "state â confID â userID â bool" (* being one of the conference chairs *)  where
"isChair s confID uID â¡ Chair ââ roles s confID uID"
abbreviation isAut :: "state â confID â userID â paperID â bool" (*  authorship of a certain paper *) where
"isAut s confID uID papID â¡ Aut papID ââ roles s confID uID"
definition isAutSome :: "state â confID â userID â bool" (*  authorship of some paper *) where
"isAutSome s confID uID â¡ list_ex (isAut s confID uID) (paperIDs s confID)"
(* all the authors of a given paper: *)
definition authors :: "state â confID â paperID â userID list" where
"authors s confID papID â¡ filter (Î» uID. isAut s confID uID papID) (userIDs s)"
abbreviation isRevNth :: "state â confID â userID â paperID â nat â bool" (*  paper reviewer (nth review) *)
where
"isRevNth s confID uID papID n â¡ Rev papID n ââ roles s confID uID"
definition isRev :: "state â confID â userID â paperID â bool" (*  paper reviewer *) where
"isRev s confID uID papID â¡ list_ex (isRevRoleFor papID) (roles s confID uID)"
(* Get the reviewer role for a certain triple (user, conference, paper), if any: *)
definition getRevRole :: "state â confID â userID â paperID â role option" where
"getRevRole s confID uID papID â¡ List.find (isRevRoleFor papID) (roles s confID uID)"
(* get the n-th review of a paper *)
definition getNthReview :: "state â paperID â nat â review" where
"getNthReview s papID n â¡ (reviewsPaper (paper s papID))!n"
(* get all the paper IDs (for all conferences) from the system: *)
definition getAllPaperIDs :: "state â paperID list" where
"getAllPaperIDs s â¡ concat [paperIDs s confID. confID â confIDs s]"
definition getReviewIndex :: "state â confID â userID â paperID â nat" where
"getReviewIndex s confID uID papID â¡
 case getRevRole s confID uID papID of Some (Rev papID' n) â n"
(* get, for a conference and a paper, the reviews together with the IDs of the reviewers: *)
definition getReviewersReviews :: "state â confID â paperID â (userID * review) list" where
"getReviewersReviews s confID papID â¡
 [(uID, getNthReview s papID (getReviewIndex s confID uID papID)).
    uID â userIDs s,
    isRev s confID uID papID
 ]"

(* Not used in the implementation: *)
definition isAUT :: "state â userID â paperID â bool" where
"isAUT s uID papID â¡ â confID. isAut s confID uID papID"
definition isREVNth :: "state â userID â paperID â nat â bool" where
"isREVNth s uID papID n â¡ â confID. isRevNth s confID uID papID n"


lemma isRev_getRevRole:
assumes "isRev s confID uID papID"
shows "getRevRole s confID uID papID â  None"
using assms list_ex_find unfolding isRev_def getRevRole_def by auto

lemma getRevRole_Some:
assumes "getRevRole s confID uID papID = Some role"
shows "â n. role = Rev papID n"
using assms unfolding getRevRole_def unfolding find_Some_iff apply (cases role, auto)
by (metis isRevRoleFor.simps)+

lemma isRev_getRevRole2:
assumes "isRev s confID uID papID"shows "â n. getRevRole s confID uID papID = Some (Rev papID n)"
using assms getRevRole_Some by (cases "getRevRole s confID uID papID") (auto simp: isRev_getRevRole)

lemma isRev_imp_isRevNth_getReviewIndex:
assumes "isRev s confID uID papID"
shows "isRevNth s confID uID papID (getReviewIndex s confID uID papID)"
proof-
  obtain n where 1: "getRevRole s confID uID papID = Some (Rev papID n)"
  using isRev_getRevRole2[OF assms] by auto
  hence "isRevNth s confID uID papID n"
  unfolding getRevRole_def unfolding find_Some_iff by auto
  moreover have "getReviewIndex s confID uID papID = n" using 1 unfolding getReviewIndex_def by simp
  ultimately show ?thesis by auto
qed

(* nonexecutable, but more useful version of the definition: *)
lemma isRev_def2:
"isRev s confID uID papID â· (â n. isRevNth s confID uID papID n)" (is "?A â· ?B")
proof
  assume ?A thus ?B using isRev_imp_isRevNth_getReviewIndex by blast
next
  assume ?B thus ?A unfolding isRev_def list_ex_iff by force
qed

(* more precise definition, but not always needed: *)
lemma isRev_def3:
"isRev s confID uID papID â· isRevNth s confID uID papID (getReviewIndex s confID uID papID)"
by (metis isRev_def2 isRev_imp_isRevNth_getReviewIndex)

lemma getFreshPaperID_getAllPaperIDs[simp]:
  assumes "confID ââ confIDs s"
  shows "Â¬ getFreshPaperID (getAllPaperIDs s) ââ paperIDs s confID"
  using assms getFreshPaperID[of "getAllPaperIDs s"]
  by (auto simp: getAllPaperIDs_def)

lemma getRevRole_Some_Rev:
"getRevRole s cid uid pid = Some (Rev pid' n) â¹ pid' = pid"
by (metis getRevRole_Some role.inject)

lemma getRevRole_Some_Rev_isRevNth:
"getRevRole s cid uid pid = Some (Rev pid' n) â¹ isRevNth s cid uid pid n"
  unfolding getRevRole_def find_Some_iff
  apply (elim exE)
  subgoal for i
    apply(cases "roles s cid uid ! i")
       apply auto
    by (metis nth_mem)
  done

(* This assumes that the list of conference IDs has exactly one element: *)
definition IDsOK :: "state â confID list â userID list â paperID list â bool"
where
"IDsOK s cIDs uIDs papIDs â¡
 list_all (Î» confID. confID ââ confIDs s) cIDs â§
 list_all (Î» uID. uID ââ userIDs s) uIDs â§
 list_all (Î» papID. papID ââ paperIDs s (hd cIDs)) papIDs"


subsection â¹The actionsâº

subsubsectionâ¹Initialization of the systemâº

definition istate :: state
where
"istate â¡
 â¦
  confIDs = [],
  conf = (Î» confID. emptyConf),
  userIDs = [voronkovUserID],
  pass = (Î» uID. emptyPass),
  user = (Î» uID. emptyUser),
  roles = (Î» confID uID. []),
  paperIDs = (Î» confID. []),
  paper = (Î» papID. emptyPaper),
  pref = (Î» uID papID. NoPref),
  voronkov = voronkovUserID,
  news = (Î» confID. []),
  phase = (Î» confID. noPH)
 â¦"



subsubsectionâ¹Actions unbound by any existing conference (with its phases)âº

(* Create new user (user) in the system: *)
(* if given user ID already taken, generate a fresh one *)
definition createUser ::  "state â userID â password â string â string â string â state"
where
"createUser s uID p name info email â¡
 let uIDs = userIDs s
 in
 s â¦userIDs := uID # uIDs,
    user := (user s) (uID := User name info email),
    pass := (pass s) (uID := p)â¦"
(* the the web interface, one should prompt the user multiple times for entering
 an unused ID *)

definition e_createUser :: "state â userID â password â string â string â string â bool" where
"e_createUser s uID p name info email â¡
 Â¬ uID ââ userIDs s"

(* updates information for user (himself), including password: *)
definition updateUser :: "state â userID â password â password â string â string â string â state"
where
"updateUser s uID p p' name info email â¡
 s â¦user := (user s) (uID := User name info email),
    pass := (pass s) (uID := p')â¦"

definition e_updateUser :: "state â userID â password â password â string â string â string â bool"
where
"e_updateUser s uID p p' name info email â¡
 IDsOK s [] [uID] [] â§ pass s uID = p"


(* read if the current user is the voronkov: *)
definition readAmIVoronkov :: "state â userID â password â bool"
where
"readAmIVoronkov s uID p â¡
 uID = voronkov s "

definition e_readAmIVoronkov :: "state â userID â password â bool"
where
"e_readAmIVoronkov s uID p â¡
 IDsOK s [] [uID] [] â§ pass s uID = p"

(* Read the name and info of a user (except for password): *)
(* There are several needs for this primitive action:
   -- either I read my own info
   -- or I am an author, and therefore I read the PC members' name and info to declare a conflict
   -- or I am a chair, and therefore I read all PC members's info to assign papers for reviewing
   -- or I am an author and need to add coauthors
*)
definition readUser :: "state â userID â password â userID â string * string * string"
where
"readUser s uID p uID' â¡
 case user s uID' of User name info email â (name, info, email)"

definition e_readUser :: "state â userID â password â userID â bool"
where
"e_readUser s uID p uID' â¡
 IDsOK s [] [uID,uID'] [] â§ pass s uID = p"

(* Request for a new conference *)

(* The request takes place by creating a new conference with ID assigned as above for users.
The conference will remain in the default "noPH" phase until aproval.
The creator becomes a chair (a fortiori a PC member). *)
definition createConf :: "state â confID â userID â password â string â string â state"
where
"createConf s confID uID p name info â¡
 let confIDs = confIDs s
 in
 s â¦confIDs := confID # confIDs,
    conf := (conf s) (confID := Conf name info),
    roles := fun_upd2 (roles s) confID uID [PC,Chair]
   â¦"
(* again, in the web interface the user will be prompted repeatedly until he gets it right *)

definition e_createConf :: "state â confID â userID â password â string â string â bool"
where
"e_createConf s confID uID p name info â¡
 IDsOK s [] [uID] [] â§ pass s uID = p â§
 Â¬ confID ââ confIDs s"

(* Read the info of a conference: any user can do it  *)
definition readConf :: "state â confID â userID â password â string * string * (role list) * phase"
where
"readConf s confID uID p â¡
 (nameConf (conf s confID), infoConf (conf s confID),
  [rl â roles s confID uID. Â¬ isRevRole rl], phase s confID)"

definition e_readConf :: "state â confID â userID â password â bool"
where
"e_readConf s confID uID p â¡
 IDsOK s [confID] [uID] [] â§ pass s uID = p"

(* list all conferences: *)
definition listConfs :: "state â userID â password â confID list"
where
"listConfs s uID p â¡
 confIDs s"

definition e_listConfs :: "state â userID â password â bool"
where
"e_listConfs s uID p â¡
 IDsOK s [] [uID] [] â§ pass s uID = p â§
 uID = voronkov s"

(* list conferences awaiting approval: *)
definition listAConfs :: "state â userID â password â confID list"
where
"listAConfs s uID p â¡
 [confID. confID â confIDs s, phase s confID = noPH]"

definition e_listAConfs :: "state â userID â password â bool"
where
"e_listAConfs s uID p â¡
 IDsOK s [] [uID] [] â§ pass s uID = p â§
 uID = voronkov s"

(* list conferences in the submission phase: any user can see this *)
definition listSConfs :: "state â userID â password â confID list"
where
"listSConfs s uID p â¡
 [confID. confID â confIDs s, phase s confID = subPH]"

definition e_listSConfs :: "state â userID â password â bool"
where
"e_listSConfs s uID p â¡
 IDsOK s [] [uID] [] â§ pass s uID = p"

(* list my conferences: *)
definition listMyConfs :: "state â userID â password â confID list"
where
"listMyConfs s uID p â¡
 [confID. confID â confIDs s , roles s confID uID â  []]"

definition e_listMyConfs :: "state â userID â password â bool"
where
"e_listMyConfs s uID p â¡
 IDsOK s [] [uID] [] â§ pass s uID = p"

(* list all users of the system (useful when assigning coauthors to papers): *)
definition listAllUsers :: "state â userID â password â userID list"
where
"listAllUsers s uID p â¡
 userIDs s"

definition e_listAllUsers :: "state â userID â password â bool"
where
"e_listAllUsers s uID p â¡
 IDsOK s [] [uID] [] â§ pass s uID = p"

(* list all paper IDs of the system (useful whn generating a fresh paper ID): *)
definition listAllPapers :: "state â userID â password â paperID list"
where
"listAllPapers s uID p â¡
 getAllPaperIDs s"

definition e_listAllPapers :: "state â userID â password â bool"
where
"e_listAllPapers s uID p â¡
 IDsOK s [] [uID] [] â§ pass s uID = p"


subsubsectionâ¹Actions available in the noPH phaseâº

(* Approving a new conference should be done by the voronkov, and happens by changing
the phase from noPH to setPH.
This is an update action: it updates the conference approval status
Note that, after approval, the voronkov should not have further access to the conference:
he can only act if the phase is noPH. *)
definition updateConfA :: "state â confID â userID â password â state"
where
"updateConfA s confID uID p â¡
 s â¦phase := (phase s) (confID := setPH)â¦"

definition e_updateConfA :: "state â confID â userID â password â bool"
where
"e_updateConfA s confID uID p â¡
 IDsOK s [confID] [uID] [] â§ pass s uID = p â§
 uID = voronkov s â§ phase s confID = noPH"


subsubsectionâ¹Actions available in the setPH phaseâº

(* make a user a PC member *)
definition createPC :: "state â confID â userID â password â userID â state"
where
"createPC s confID uID p uID' â¡
 let rls = roles s confID uID'
 in
 s â¦roles := fun_upd2 (roles s) confID uID' (List.insert PC rls)â¦"

definition e_createPC :: "state â confID â userID â password â userID â bool"
where
"e_createPC s confID uID p uID' â¡
 let uIDs = userIDs s
 in
 IDsOK s [confID] [uID,uID'] [] â§ pass s uID = p â§
 phase s confID = setPH â§ isChair s confID uID"

(* make a user a chair (a fortiori a PC member) *)
definition createChair :: "state â confID â userID â password â userID â state"
where
"createChair s confID uID p uID' â¡
 let rls = roles s confID uID'
 in
 s â¦roles := fun_upd2 (roles s) confID uID' (List.insert PC (List.insert Chair rls))â¦"

definition e_createChair :: "state â confID â userID â password â userID â bool"
where
"e_createChair s confID uID p uID' â¡
 let uIDs = userIDs s
 in
 IDsOK s [confID] [uID,uID'] [] â§ pass s uID = p â§
 phase s confID = setPH â§ isChair s confID uID"


subsubsectionâ¹Actions available starting from the setPH phaseâº

definition updatePhase :: "state â confID â userID â password â phase â state" where
"updatePhase s confID uID p ph â¡
 s â¦phase := (phase s) (confID := ph)â¦"

definition e_updatePhase :: "state â confID â userID â password â phase â bool" where
"e_updatePhase s confID uID p ph â¡
 IDsOK s [confID] [uID] [] â§ pass s uID = p â§
 phase s confID â¥ setPH â§ phase s confID < closedPH â§ isChair s confID uID â§
 ph = SucPH (phase s confID)"
(* The phase move is only allowed if the indicated phase is the successor of the current phase.
   Yet, in the kernel we also require the explicit indication of the phase for being able to track
   it for verification.  *)
(* In the web interface, the user is prompted with the question
"Are you sure you want to move to the next phase?" *)

(* Add an event, i.e., undestructively update the news: *)
definition uupdateNews :: "state â confID â userID â password â string â state"
where
"uupdateNews s confID uID p ev â¡
 let evs = news s confID
 in
 s â¦news := (news s) (confID := ev # evs)â¦"

definition e_uupdateNews :: "state â confID â userID â password â string â bool"
where
"e_uupdateNews s confID uID p ev â¡
 IDsOK s [confID] [uID] [] â§ pass s uID = p â§
 phase s confID â¥ setPH â§ phase s confID < closedPH â§ isChair s confID uID"

definition readNews :: "state â confID â userID â password â string list"
where
"readNews s confID uID p â¡
 news s confID"

definition e_readNews :: "state â confID â userID â password â bool"
where
"e_readNews s confID uID p â¡
 IDsOK s [confID] [uID] [] â§ pass s uID = p â§
 phase s confID â¥ setPH â§ isPC s confID uID"

(* list the committee members: *)
definition listPC :: "state â confID â userID â password â userID list"
where
"listPC s confID uID p â¡
 [uID. uID â userIDs s, isPC s confID uID]"

definition e_listPC :: "state â confID â userID â password â bool"
where
"e_listPC s confID uID p â¡
 IDsOK s [confID] [uID] [] â§ pass s uID = p â§
 (phase s confID â¥ subPH â¨ (phase s confID â¥ setPH â§ isChair s confID uID))"

(* list the chairs: *)
definition listChair :: "state â confID â userID â password â userID list"
where
"listChair s confID uID p â¡
 [uID. uID â userIDs s, isChair s confID uID]"

definition e_listChair :: "state â confID â userID â password â bool"
where
"e_listChair s confID uID p â¡
 IDsOK s [confID] [uID] [] â§ pass s uID = p â§
 (phase s confID â¥ subPH â¨ (phase s confID â¥ setPH â§ isChair s confID uID))"


subsubsectionâ¹Actions available in the subPH phaseâº

(* create new paper: *)
definition createPaper :: "state â confID â userID â password â paperID â string â string â state"
where
"createPaper s confID uID p papID title abstract â¡
 let papIDs = paperIDs s confID;
     rls = roles s confID uID
 in
 s â¦paperIDs := (paperIDs s) (confID := papID # papIDs),
    paper := (paper s) (papID := Paper title abstract NoPContent [] (Dis []) []),
    roles := fun_upd2 (roles s) confID uID (List.insert (Aut papID) rls),
    pref :=  fun_upd2 (pref s) uID papID Conflictâ¦"
(* this contains an update to the preference too, to make sure that a user does not end up
reviewing his own paper! note that preference can be set even if the author is not a reviewer,
which is OK*)

definition e_createPaper :: "state â confID â userID â password â paperID â string â string â bool"
where
"e_createPaper s confID uID p papID name info â¡
 IDsOK s [confID] [uID] [] â§ pass s uID = p â§
 phase s confID = subPH â§
 Â¬ papID ââ getAllPaperIDs s"

(* add author to a paper: only an author can do this *)
definition createAuthor :: "state â confID â userID â password â paperID â userID â state"
where
"createAuthor s confID uID p papID uID' â¡
 let rls = roles s confID uID'
 in
 s â¦roles := fun_upd2 (roles s) confID uID' (List.insert (Aut papID) rls),
    pref :=  fun_upd2 (pref s) uID' papID Conflictâ¦"
(* again, preference is set to Conflict *)

definition e_createAuthor :: "state â confID â userID â password â paperID â userID â bool"
where
"e_createAuthor s confID uID p papID uID' â¡
 IDsOK s [confID] [uID,uID'] [papID] â§ pass s uID = p â§
 phase s confID = subPH â§ isAut s confID uID papID â§ uID â  uID'"

(* update name (title) and info of paper: *)
definition updatePaperTA :: "state â confID â userID â password â paperID â string â string â state"
where
"updatePaperTA s confID uID p papID title abstract â¡
 case paper s papID of Paper title' abstract' pc reviews dis decs â
 s â¦paper := (paper s) (papID := Paper title abstract pc reviews dis decs)â¦"

definition e_updatePaperTA :: "state â confID â userID â password â paperID â string â string â bool"
where
"e_updatePaperTA s confID uID p papID name info â¡
 IDsOK s [confID] [uID] [papID] â§ pass s uID = p â§
 phase s confID = subPH â§ isAut s confID uID papID"

(* upload new version of paper content: *)
definition updatePaperC :: "state â confID â userID â password â paperID â pcontent â state"
where
"updatePaperC s confID uID p papID pc â¡
 case paper s papID of Paper title abstract pc' reviews dis decs â
 s â¦paper := (paper s) (papID := Paper title abstract pc reviews dis decs)â¦"

definition e_updatePaperC :: "state â confID â userID â password â paperID â pcontent â bool"
where
"e_updatePaperC s confID uID p papID pc â¡
 IDsOK s [confID] [uID] [papID] â§ pass s uID = p â§
 phase s confID = subPH â§ isAut s confID uID papID"

(* declare conflict of the authored paper with a committee member*)
definition createConflict :: "state â confID â userID â password â paperID â userID â state"
where
"createConflict s confID uID p papID uID' â¡
 s â¦pref := fun_upd2 (pref s) uID' papID Conflictâ¦"

definition e_createConflict :: "state â confID â userID â password â paperID â userID â bool"
where
"e_createConflict s confID uID p papID uID' â¡
 IDsOK s [confID] [uID,uID'] [papID] â§ pass s uID = p â§
 phase s confID = subPH â§ isAut s confID uID papID â§ isPC s confID uID'"


subsubsectionâ¹Actions available starting from the subPH phaseâº

(* read a paper's title, abstract and authors: *)
definition readPaperTAA :: "state â confID â userID â password â paperID â
    (string * string *  userID list)"
where
"readPaperTAA s confID uID p papID â¡
 case paper s papID of Paper title abstract pc reviews dis decs â
   (title, abstract, [uID. uID â userIDs s , isAut s confID uID papID])"

definition e_readPaperTAA :: "state â confID â userID â password â paperID â bool"
where
"e_readPaperTAA s confID uID p papID â¡
 IDsOK s [confID] [uID] [papID] â§ pass s uID = p â§
 phase s confID â¥ subPH â§ (isAut s confID uID papID â¨ isPC s confID uID)"

(* read a paper's content: *)
definition readPaperC :: "state â confID â userID â password â paperID â pcontent"
where
"readPaperC s confID uID p papID â¡
 case paper s papID of Paper title abstract pc reviews dis decs â pc"

definition e_readPaperC :: "state â confID â userID â password â paperID â bool"
where
"e_readPaperC s confID uID p papID â¡
 IDsOK s [confID] [uID] [papID] â§ pass s uID = p â§
 (
  phase s confID â¥ subPH â§ isAut s confID uID papID â¨
  phase s confID â¥ bidPH â§ isPC s confID uID
 )"

(* Note that the difference between the enabledness of readPaperTAA and that of readPaperC is
that the latter is allowed for the PC members only in the bidding phase.  *)

(* list all papers associated to a conference (with which the committee member does not have conflict): *)
definition listPapers :: "state â confID â userID â password â paperID list"
where
"listPapers s confID uID p â¡
 let paps = paper s in
 [papID. papID â paperIDs s confID]"

definition e_listPapers :: "state â confID â userID â password â bool"
where
"e_listPapers s confID uID p â¡
 IDsOK s [confID] [uID] [] â§ pass s uID = p â§
 phase s confID â¥ subPH â§ isPC s confID uID"

(* list my (authored) papers: *)
definition listMyPapers :: "state â confID â userID â password â paperID list"
where
"listMyPapers s confID uID p â¡
 let paps = paper s in
 [papID. papID â paperIDs s confID, isAut s confID uID papID]"

definition e_listMyPapers :: "state â confID â userID â password â bool"
where
"e_listMyPapers s confID uID p â¡
 IDsOK s [confID] [uID] [] â§ pass s uID = p â§
 phase s confID â¥ subPH"


subsubsectionâ¹Actions available in the bidPH phaseâº

(* update (my) preference: *)
definition updatePref :: "state â confID â userID â password â paperID â preference â state"
where
"updatePref s confID uID p papID pr â¡
 s â¦pref := fun_upd2 (pref s) uID papID prâ¦"

definition e_updatePref :: "state â confID â userID â password â paperID â preference â bool"
where
"e_updatePref s confID uID p papID pr â¡
 IDsOK s [confID] [uID] [papID] â§ pass s uID = p â§
 phase s confID = bidPH â§ isPC s confID uID â§
 Â¬ isAut s confID uID papID"
(* note: if an author of the paper, conflict was marked in the first place,
   and updating is not allowed *)


subsubsectionâ¹Actions available starting from the bidPH phaseâº

(* read (my) preference: *)
definition readPref :: "state â confID â userID â password â paperID â preference"
where
"readPref s confID uID p papID â¡
 pref s uID papID"

definition e_readPref :: "state â confID â userID â password â paperID â bool"
where
"e_readPref s confID uID p papID â¡
 IDsOK s [confID] [uID] [papID] â§ pass s uID = p â§
 phase s confID â¥ bidPH â§ isPC s confID uID"


subsubsectionâ¹Actions available in the revPH phaseâº

(* read preferences of a committee member (useful for the chair to read the preferences of the
committee members: *)

definition readPrefOfPC :: "state â confID â userID â password â paperID â userID â preference"
where
"readPrefOfPC s confID uID p papID uID' â¡
 pref s uID' papID"

definition e_readPrefOfPC :: "state â confID â userID â password â paperID â userIDâ bool"
where
"e_readPrefOfPC s confID uID p papID uID' â¡
 IDsOK s [confID] [uID,uID'] [papID] â§ pass s uID = p â§
 (phase s confID â¥ bidPH â§ isChair s confID uID â§ isPC s confID uID'
  â¨
  phase s confID = subPH â§ isAut s confID uID papID)"
(* unique violation of monotonicity for read actions: an author can read the preferences of the PC chair
  in the submission phase, but not later, as later they will have been updated by the chairs *)

(* create a review and assign a reviewer: *)
definition createReview :: "state â confID â userID â password â paperID â userID â state"
where
"createReview s confID uID p papID uID' â¡
 case paper s papID of Paper title abstract pc reviews dis decs â
   let rls = roles s confID uID'; n = length (reviewsPaper (paper s papID));
       reviews' = reviews @ [emptyReview]
   in
   s â¦roles := fun_upd2 (roles s) confID uID' (List.insert (Rev papID n) rls),
      paper := fun_upd (paper s) papID (Paper title abstract pc reviews' dis decs)
     â¦"
(* note: the new review is added at the end, in order not to disrupt the indexing of the other reviews *)

definition e_createReview :: "state â confID â userID â password â paperID â userID â bool"
where
"e_createReview s confID uID p papID uID' â¡
 IDsOK s [confID] [uID,uID'] [papID] â§ pass s uID = p â§
 phase s confID = revPH â§
 isChair s confID uID â§ pref s uID papID â  Conflict â§
 isPC s confID uID' â§ Â¬ isRev s confID uID' papID â§ pref s uID' papID â  Conflict"

(* update the review that I write: *)
definition updateReview ::
"state â confID â userID â password â paperID â nat â rcontent â state"
where
"updateReview s confID uID p papID n rc â¡
 case paper s papID of Paper title abstract pc reviews dis decs â
   let review = [rc]; reviews' = list_update reviews n review
   in
   s â¦paper := fun_upd (paper s) papID (Paper title abstract pc reviews' dis decs)â¦"

definition e_updateReview ::
"state â confID â userID â password â paperID â nat â rcontent â bool"
where
"e_updateReview s confID uID p papID n rc â¡
 IDsOK s [confID] [uID] [papID] â§ pass s uID = p â§
 phase s confID = revPH â§ isRev s confID uID papID â§
 getReviewIndex s confID uID papID = n"


subsubsectionâ¹Actions available starting from the revPH phaseâº

(* read the review that I write: *)
definition readMyReview :: "state â confID â userID â password â paperID â nat * review"
where
"readMyReview s confID uID p papID â¡
 case getRevRole s confID uID papID of
   Some (Rev papID' n) â (n, getNthReview s papID n)"

definition e_readMyReview :: "state â confID â userID â password â paperID â bool"
where
"e_readMyReview s confID uID p papID â¡
 IDsOK s [confID] [uID] [papID] â§ pass s uID = p â§
 phase s confID â¥ revPH â§ isRev s confID uID papID"

(* list my assigned papers: *)
definition listMyAssignedPapers :: "state â confID â userID â password â paperID list"
where
"listMyAssignedPapers s confID uID p â¡
 let paps = paper s in
 [papID. papID â paperIDs s confID, isRev s confID uID papID]"

definition e_listMyAssignedPapers :: "state â confID â userID â password â bool"
where
"e_listMyAssignedPapers s confID uID p â¡
 IDsOK s [confID] [uID] [] â§ pass s uID = p â§
 phase s confID â¥ revPH â§ isPC s confID uID"


definition listAssignedReviewers :: "state â confID â userID â password â paperID â userID list"
where
"listAssignedReviewers s confID uID p papID â¡
 [uID â userIDs s. isRev s confID uID papID]"

definition e_listAssignedReviewers :: "state â confID â userID â password â paperID â bool"
where
"e_listAssignedReviewers s confID uID p papID â¡
 IDsOK s [confID] [uID] [papID] â§ pass s uID = p â§
 phase s confID â¥ revPH â§
 isChair s confID uID â§ pref s uID papID â  Conflict"


subsubsectionâ¹Actions available in the disPH phaseâº

(* undestructively update the discussion with a comment: *)
definition uupdateDis :: "state â confID â userID â password â paperID â string â state"
where
"uupdateDis s confID uID p papID comm â¡
 case paper s papID of Paper title abstract pc reviews (Dis comments) decs â
   s â¦paper := fun_upd (paper s) papID (Paper title abstract pc reviews (Dis (comm # comments)) decs)â¦"

definition e_uupdateDis :: "state â confID â userID â password â paperID â string â bool"
where
"e_uupdateDis s confID uID p papID comm â¡
 IDsOK s [confID] [uID] [papID] â§ pass s uID = p â§
 phase s confID = disPH â§ isPC s confID uID â§ pref s uID papID â  Conflict"

(* correct my review during the discussion
(instance of a undestructive update) *)
definition uupdateReview ::
"state â confID â userID â password â paperID â nat â rcontent â state"
where
"uupdateReview s confID uID p papID n rc â¡
 case paper s papID of Paper title abstract pc reviews dis decs â
   let review = rc # (reviews ! n); reviews' = list_update reviews n review
   in
   s â¦paper := fun_upd (paper s) papID (Paper title abstract pc reviews' dis decs)â¦"

definition e_uupdateReview ::
"state â confID â userID â password â paperID â nat â rcontent â bool"
where
"e_uupdateReview s confID uID p papID n rc â¡
 IDsOK s [confID] [uID] [papID] â§ pass s uID = p â§
 phase s confID = disPH â§ isRev s confID uID papID â§
 getReviewIndex s confID uID papID = n"

(* update the decision for a paper (again undestructive update) : *)
definition uupdateDec :: "state â confID â userID â password â paperID â decision â state"
where
"uupdateDec s confID uID p papID dec â¡
 case paper s papID of Paper title abstract pc reviews dis decs â
   s â¦paper := fun_upd (paper s) papID (Paper title abstract pc reviews dis (dec # decs))â¦"

definition e_uupdateDec :: "state â confID â userID â password â paperID â decision â bool"
where
"e_uupdateDec s confID uID p papID dec â¡
 IDsOK s [confID] [uID] [papID] â§ pass s uID = p â§
 phase s confID = disPH â§ isChair s confID uID â§ pref s uID papID â  Conflict"


subsubsectionâ¹Actions available starting from the disPH phaseâº

(* read all the reviews to a paper (including all the updates) with the IDs of the reviewers: *)
definition readReviews :: "state â confID â userID â password â paperID â (userID * review) list"
where
"readReviews s confID uID p papID â¡
 getReviewersReviews s confID papID"

definition e_readReviews :: "state â confID â userID â password â paperID â bool"
where
"e_readReviews s confID uID p papID â¡
 IDsOK s [confID] [uID] [papID] â§ pass s uID = p â§
 phase s confID â¥ disPH â§ isPC s confID uID â§ pref s uID papID â  Conflict"

(* read the decisions (i.e., the decision history) for a paper: *)
definition readDecs :: "state â confID â userID â password â paperID â decision list"
where
"readDecs s confID uID p papID â¡
 case paper s papID of Paper title abstract pc reviews dis decs â decs"

definition e_readDecs :: "state â confID â userID â password â paperID â bool"
where
"e_readDecs s confID uID p papID â¡
 IDsOK s [confID] [uID] [papID] â§ pass s uID = p â§
 phase s confID â¥ disPH â§ isPC s confID uID â§ pref s uID papID â  Conflict"

(* read the discussion to a paper: *)
definition readDis :: "state â confID â userID â password â paperID â string list"
where
"readDis s confID uID p papID â¡
 case paper s papID of Paper title abstract pc reviews (Dis comments) decs â comments"

definition e_readDis :: "state â confID â userID â password â paperID â bool"
where
"e_readDis s confID uID p papID â¡
 IDsOK s [confID] [uID] [papID] â§ pass s uID = p â§
 phase s confID â¥ disPH â§ isPC s confID uID â§ pref s uID papID â  Conflict"



subsubsectionâ¹Actions available starting from the notifPH phaseâº

(* read final reviews to a paper: available to the authors and all non-conflicted PC members *)
definition readFinalReviews :: "state â confID â userID â password â paperID â review list"
where
"readFinalReviews s confID uID p papID â¡
 map (Î» rev. case rev of [] â [(NoExp,NoScore,emptyStr)]
                        |((exp,score,comm) # rv) â [(exp,score,comm)])
 (reviewsPaper (paper s papID))"

definition e_readFinalReviews :: "state â confID â userID â password â paperID â bool"
where
"e_readFinalReviews s confID uID p papID â¡
 IDsOK s [confID] [uID] [papID] â§ pass s uID = p â§
 phase s confID â¥ notifPH â§ (isAut s confID uID papID â¨ (isPC s confID uID â§ pref s uID papID â  Conflict))"

(* read the final decision for a paper available to the authors and all PC members (including conflicted PC members):*)
definition readFinalDec :: "state â confID â userID â password â paperID â decision"
where
"readFinalDec s confID uID p papID â¡
 case paper s papID of Paper title abstract pc reviews dis decs â
   case decs of [] â NoDecision | dec # decs â dec"

definition e_readFinalDec :: "state â confID â userID â password â paperID â bool"
where
"e_readFinalDec s confID uID p papID â¡
 IDsOK s [confID] [uID] [papID] â§ pass s uID = p â§
 phase s confID â¥ notifPH â§ (isAut s confID uID papID â¨ isPC s confID uID)"


subsectionâ¹The step functionâº

datatype out =
  outOK | outErr | (* OK and error, outputs for list, update and u-update  actions *)
  outBool bool|
  outSTRT "string * string * string" | outSTRL "string list" | outCONF "string * string * role list * phase" |
  outPREF preference |
  outCON pcontent |
  outNREV "nat * review" | outREVL "review list" | outRREVL "(userID * review) list" |
  outDEC "decision" | outDECL "decision list" |
  outCIDL "confID list" |   outUIDL "userID list" | outPIDL "paperID list"|
  outSTRPAL "string * string * userID list"

datatype cAct =
  cUser userID password string string string
 |cConf confID userID password string string
 |cPC confID userID password userID
 |cChair confID userID password userID
 |cPaper confID userID password paperID string string
 |cAuthor confID userID password paperID userID
 |cConflict confID userID password paperID userID
 |cReview confID userID password paperID userID

lemmas c_defs =
e_createUser_def createUser_def
e_createConf_def createConf_def
e_createPC_def createPC_def
e_createChair_def createChair_def
e_createAuthor_def createAuthor_def
e_createConflict_def createConflict_def
e_createPaper_def createPaper_def
e_createReview_def createReview_def

fun cStep :: "state â cAct â out * state" where
"cStep s (cUser uID p name info email) =
 (if e_createUser s uID p name info email
    then (outOK, createUser s uID p name info email)
    else (outErr, s))"
|
"cStep s (cConf confID uID p name info) =
 (if e_createConf s confID uID p name info
    then (outOK, createConf s confID uID p name info)
    else (outErr, s))"
|
"cStep s (cPC confID uID p uID') =
 (if e_createPC s confID uID p uID'
    then (outOK, createPC s confID uID p uID')
    else (outErr, s))"
|
"cStep s (cChair confID uID p uID') =
 (if e_createChair s confID uID p uID'
    then (outOK, createChair s confID uID p uID')
    else (outErr, s))"
|
"cStep s (cPaper confID uID p papID name info) =
 (if e_createPaper s confID uID p papID name info
    then (outOK, createPaper s confID uID p papID name info)
    else (outErr, s))"
|
"cStep s (cAuthor confID uID p papID uID') =
 (if e_createAuthor s confID uID p papID uID'
    then (outOK, createAuthor s confID uID p papID uID')
    else (outErr, s))"
|
"cStep s (cConflict confID uID p papID uID') =
 (if e_createConflict s confID uID p papID uID'
    then (outOK, createConflict s confID uID p papID uID')
    else (outErr, s))"
|
"cStep s (cReview confID uID p papID uID') =
 (if e_createReview s confID uID p papID uID'
    then (outOK, createReview s confID uID p papID uID')
    else (outErr, s))"


datatype uAct =
  uUser userID password password string string string
 |uConfA confID userID password
 |uPhase confID userID password phase
 |uPaperTA confID userID password paperID string string
 |uPaperC confID userID password paperID pcontent
 |uPref confID userID password paperID preference
 |uReview confID userID password paperID nat rcontent

lemmas u_defs =
e_updateUser_def updateUser_def
e_updateConfA_def updateConfA_def
e_updatePhase_def updatePhase_def
e_updatePaperTA_def updatePaperTA_def
e_updatePaperC_def updatePaperC_def
e_updatePref_def updatePref_def
e_updateReview_def updateReview_def

fun uStep :: "state â uAct â out * state" where
"uStep s (uUser uID p p' name info email) =
 (if e_updateUser s uID p p' name info email
    then (outOK, updateUser s uID p p' name info email)
    else (outErr, s))"
|
"uStep s (uConfA confID uID p) =
 (if e_updateConfA s confID uID p
    then (outOK, updateConfA s confID uID p)
    else (outErr, s))"
|
"uStep s (uPhase confID uID p ph) =
 (if e_updatePhase s confID uID p ph
    then (outOK, updatePhase s confID uID p ph)
    else (outErr, s))"
|
"uStep s (uPaperTA confID uID p papID name info) =
 (if e_updatePaperTA s confID uID p papID name info
    then (outOK, updatePaperTA s confID uID p papID name info)
    else (outErr, s))"
|
"uStep s (uPaperC confID uID p papID pc) =
 (if e_updatePaperC s confID uID p papID pc
    then (outOK, updatePaperC s confID uID p papID pc)
    else (outErr, s))"
|
"uStep s (uPref confID uID p papID pr) =
 (if e_updatePref s confID uID p papID pr
    then (outOK, updatePref s confID uID p papID pr)
    else (outErr, s))"
|
"uStep s (uReview confID uID p papID n rc) =
 (if e_updateReview s confID uID p papID n rc
    then (outOK, updateReview s confID uID p papID n rc)
    else (outErr, s))"


datatype uuAct =
  uuNews confID userID password string
 |uuDis confID userID password paperID string
 |uuReview confID userID password paperID nat rcontent
 |uuDec confID userID password paperID decision

lemmas uu_defs =
e_uupdateNews_def uupdateNews_def
e_uupdateDis_def uupdateDis_def
e_uupdateReview_def uupdateReview_def
uupdateDec_def e_uupdateDec_def

fun uuStep :: "state â uuAct â out * state" where
"uuStep s (uuNews confID uID p ev) =
 (if e_uupdateNews s confID uID p ev
    then (outOK, uupdateNews s confID uID p ev)
    else (outErr, s))"
|
"uuStep s (uuDis confID uID p papID comm) =
 (if e_uupdateDis s confID uID p papID comm
    then (outOK, uupdateDis s confID uID p papID comm)
    else (outErr, s))"
|
"uuStep s (uuReview confID uID p papID n rc) =
 (if e_uupdateReview s confID uID p papID n rc
    then (outOK, uupdateReview s confID uID p papID n rc)
    else (outErr, s))"
|
"uuStep s (uuDec confID uID p papID dec) =
 (if e_uupdateDec s confID uID p papID dec
    then (outOK, uupdateDec s confID uID p papID dec)
    else (outErr, s))"

datatype rAct =
  rAmIVoronkov userID password
 |rUser userID password userID
 |rConf confID userID password
 |rNews confID userID password
 |rPaperTAA confID userID password paperID
 |rPaperC confID userID password paperID
 |rPref confID userID password paperID
 |rMyReview confID userID password paperID
 |rReviews confID userID password paperID
 |rDecs confID userID password paperID
 |rDis confID userID password paperID
 |rFinalReviews confID userID password paperID
 |rFinalDec confID userID password paperID
 |rPrefOfPC confID userID password paperID userID

lemmas r_defs =
  readAmIVoronkov_def e_readAmIVoronkov_def
 readUser_def e_readUser_def
 readConf_def e_readConf_def
 readNews_def e_readNews_def
 readPaperTAA_def e_readPaperTAA_def
 readPaperC_def e_readPaperC_def
 readPref_def e_readPref_def
 readMyReview_def e_readMyReview_def
 readReviews_def e_readReviews_def
 readDecs_def e_readDecs_def
 readDis_def e_readDis_def
 readFinalReviews_def e_readFinalReviews_def
 readFinalDec_def e_readFinalDec_def
 readPrefOfPC_def e_readPrefOfPC_def

fun rObs :: "state â rAct â out" where
"rObs s (rAmIVoronkov uID p) =
 (if e_readAmIVoronkov s uID p then outBool (readAmIVoronkov s uID p) else outErr)"
|
"rObs s (rUser uID p uID') =
 (if e_readUser s uID p uID' then outSTRT (readUser s uID p uID') else outErr)"
|
"rObs s (rConf confID uID p) =
 (if e_readConf s confID uID p then outCONF (readConf s confID uID p) else outErr)"
|
"rObs s (rNews confID uID p) =
 (if e_readNews s confID uID p then outSTRL (readNews s confID uID p) else outErr)"
|
"rObs s (rPaperTAA confID uID p papID) =
 (if e_readPaperTAA s confID uID p papID then outSTRPAL (readPaperTAA s confID uID p papID) else outErr)"
|
"rObs s (rPaperC confID uID p papID) =
 (if e_readPaperC s confID uID p papID then outCON (readPaperC s confID uID p papID) else outErr)"
|
"rObs s (rPref confID uID p papID) =
 (if e_readPref s confID uID p papID then outPREF (readPref s confID uID p papID) else outErr)"
|
"rObs s (rMyReview confID uID p papID) =
 (if e_readMyReview s confID uID p papID then outNREV (readMyReview s confID uID p papID) else outErr)"
|
"rObs s (rReviews confID uID p papID) =
 (if e_readReviews s confID uID p papID then outRREVL (readReviews s confID uID p papID) else outErr)"
|
"rObs s (rDecs confID uID p papID) =
 (if e_readDecs s confID uID p papID then outDECL (readDecs s confID uID p papID) else outErr)"
|
"rObs s (rDis confID uID p papID) =
 (if e_readDis s confID uID p papID then outSTRL (readDis s confID uID p papID) else outErr)"
|
"rObs s (rFinalReviews confID uID p papID) =
 (if e_readFinalReviews s confID uID p papID then outREVL (readFinalReviews s confID uID p papID) else outErr)"
|
"rObs s (rFinalDec confID uID p papID) =
 (if e_readFinalDec s confID uID p papID then outDEC (readFinalDec s confID uID p papID) else outErr)"
|
"rObs s (rPrefOfPC confID uID p papID uID') =
 (if e_readPrefOfPC s confID uID p papID uID' then outPREF (readPrefOfPC s confID uID p papID uID') else outErr)"

datatype lAct =
  lConfs userID password
 |lAConfs userID password
 |lSConfs userID password
 |lMyConfs userID password
 |lAllUsers userID password
 |lAllPapers userID password
 |lPC confID userID password
 |lChair confID userID password
 |lPapers confID userID password
 |lMyPapers confID userID password
 |lMyAssignedPapers confID userID password
 |lAssignedReviewers confID userID password paperID

lemmas l_defs =
 listConfs_def e_listConfs_def
 listAConfs_def e_listAConfs_def
 listSConfs_def e_listSConfs_def
 listMyConfs_def e_listMyConfs_def
 listAllUsers_def e_listAllUsers_def
 listAllPapers_def e_listAllPapers_def
 listPC_def e_listPC_def
 listChair_def e_listChair_def
 listPapers_def e_listPapers_def
 listMyPapers_def e_listMyPapers_def
 listMyAssignedPapers_def e_listMyAssignedPapers_def
 listAssignedReviewers_def e_listAssignedReviewers_def

fun lObs :: "state â lAct â out" where
"lObs s (lConfs uID p) =
 (if e_listConfs s uID p then outCIDL (listConfs s uID p) else outErr)"
|
"lObs s (lAConfs uID p) =
 (if e_listAConfs s uID p then outCIDL (listAConfs s uID p) else outErr)"
|
"lObs s (lSConfs uID p) =
 (if e_listSConfs s uID p then outCIDL (listSConfs s uID p) else outErr)"
|
"lObs s (lMyConfs uID p) =
 (if e_listMyConfs s uID p then outCIDL (listMyConfs s uID p) else outErr)"
|
"lObs s (lAllUsers uID p) =
 (if e_listAllUsers s uID p then outUIDL (listAllUsers s uID p) else outErr)"
|
"lObs s (lAllPapers uID p) =
 (if e_listAllPapers s uID p then outPIDL (listAllPapers s uID p) else outErr)"
|
"lObs s (lPC confID uID p) =
 (if e_listPC s confID uID p then outUIDL (listPC s confID uID p) else outErr)"
|
"lObs s (lChair confID uID p) =
 (if e_listChair s confID uID p then outUIDL (listChair s confID uID p) else outErr)"
|
"lObs s (lPapers confID uID p) =
 (if e_listPapers s confID uID p then outPIDL (listPapers s confID uID p) else outErr)"
|
"lObs s (lMyPapers confID uID p) =
 (if e_listMyPapers s confID uID p then outPIDL (listMyPapers s confID uID p) else outErr)"
|
"lObs s (lMyAssignedPapers confID uID p) =
 (if e_listMyAssignedPapers s confID uID p then outPIDL (listMyAssignedPapers s confID uID p) else outErr)"
|
"lObs s (lAssignedReviewers confID uID p papID) =
 (if e_listAssignedReviewers s confID uID p papID
   then outUIDL (listAssignedReviewers s confID uID p papID) else outErr)"

datatype act =
(* 3 kinds of effects: creation, update and undestructive update *)
  Cact cAct | Uact uAct | UUact uuAct |
(* 2 kinds of observations: reading and listing (the latter mainly printing IDs) *)
  Ract rAct | Lact lAct

fun step :: "state â act â out * state" where
"step s (Cact ca) = cStep s ca"
|
"step s (Uact ua) = uStep s ua"
|
"step s (UUact uua) = uuStep s uua"
|
"step s (Ract ra) = (rObs s ra, s)"
|
"step s (Lact la) = (lObs s la, s)"

export_code step istate getFreshPaperID in Scala


text â¹Some action selectors, used for verification:âº

(* The user (subject) of an action: *)
fun cUserOfA :: "cAct â userID" where
"cUserOfA (cUser uID p name info email) = uID" (* time when a uID appears is an action of uID itself *)
|
"cUserOfA (cConf confID uID p name info) = uID"
|
"cUserOfA (cPC confID uID p uID') = uID"
|
"cUserOfA (cChair confID uID p uID') = uID"
|
"cUserOfA (cPaper confID uID p papID name info) = uID"
|
"cUserOfA (cAuthor confID uID p papID uID') = uID"
|
"cUserOfA (cConflict confID uID p papID uID') = uID"
|
"cUserOfA (cReview confID uID p papID uID') = uID"

fun uUserOfA :: "uAct â userID" where
"uUserOfA (uUser uID p p' name info email) = uID"
|
"uUserOfA (uConfA confID uID p) = uID"
|
"uUserOfA (uPhase confID uID p ph) = uID"
|
"uUserOfA (uPaperTA confID uID p papID name info) = uID"
|
"uUserOfA (uPaperC confID uID p papID pc) = uID"
|
"uUserOfA (uPref confID uID p papID pr) = uID"
|
"uUserOfA (uReview confID uID p papID n rc) = uID"

fun uuUserOfA :: "uuAct â userID" where
"uuUserOfA (uuNews confID uID p ev) = uID"
|
"uuUserOfA (uuDis confID uID p papID comm) = uID"
|
"uuUserOfA (uuReview confID uID p papID n rc) = uID"
|
"uuUserOfA (uuDec confID uID p papID dec) = uID"

fun rUserOfA :: "rAct â userID" where
"rUserOfA (rAmIVoronkov uID p) = uID"
|
"rUserOfA (rUser uID p uID') = uID"
|
"rUserOfA (rConf confID uID p) = uID"
|
"rUserOfA (rNews confID uID p) = uID"
|
"rUserOfA (rPaperTAA confID uID p papID) = uID"
|
"rUserOfA (rPaperC confID uID p papID) = uID"
|
"rUserOfA (rPref confID uID p papID) = uID"
|
"rUserOfA (rMyReview confID uID p papID) = uID"
|
"rUserOfA (rReviews confID uID p papID) = uID"
|
"rUserOfA (rDecs confID uID p papID) = uID"
|
"rUserOfA (rDis confID uID p papID) = uID"
|
"rUserOfA (rFinalReviews confID uID p papID) = uID"
|
"rUserOfA (rFinalDec confID uID p papID) = uID"
|
"rUserOfA (rPrefOfPC confID uID p papID uID') = uID"

fun lUserOfA :: "lAct â userID" where
"lUserOfA (lConfs uID p) = uID"
|
"lUserOfA (lAConfs uID p) = uID"
|
"lUserOfA (lSConfs uID p) = uID"
|
"lUserOfA (lMyConfs uID p) = uID"
|
"lUserOfA (lAllUsers uID p) = uID"
|
"lUserOfA (lAllPapers uID p) = uID"
|
"lUserOfA (lPC confID uID p) = uID"
|
"lUserOfA (lChair confID uID p) = uID"
|
"lUserOfA (lPapers confID uID p) = uID"
|
"lUserOfA (lMyPapers confID uID p) = uID"
|
"lUserOfA (lMyAssignedPapers confID uID p) = uID"
|
"lUserOfA (lAssignedReviewers confID uID p papID) = uID"

fun userOfA :: "act â userID" where
"userOfA (Cact ca) = cUserOfA ca"
|
"userOfA (Uact ua) = uUserOfA ua"
|
"userOfA (UUact uua) = uuUserOfA uua"
|
"userOfA (Ract ra) = rUserOfA ra"
|
"userOfA (Lact la) = lUserOfA la"


(* The conference (framework, context) of an action: *)
fun cConfOfA :: "cAct â confID option" where
"cConfOfA (cUser uID p name info email) = None"
|
"cConfOfA (cConf confID uID p name info) = Some confID"
(* time when a confID appears is an action bearing its ID *)
|
"cConfOfA (cPC confID uID p uID') = Some confID"
|
"cConfOfA (cChair confID uID p uID') = Some confID"
|
"cConfOfA (cPaper confID uID p papID name info) = Some confID"
|
"cConfOfA (cAuthor confID uID p papID uID') = Some confID"
|
"cConfOfA (cConflict confID uID p papID uID') = Some confID"
|
"cConfOfA (cReview confID uID p papID uID') = Some confID"

fun uConfOfA :: "uAct â confID option" where
"uConfOfA (uUser uID p p' name info email) = None"
|
"uConfOfA (uConfA confID uID p) = Some confID"
|
"uConfOfA (uPhase confID uID p ph) = Some confID"
|
"uConfOfA (uPaperTA confID uID p papID name info) = Some confID"
|
"uConfOfA (uPaperC confID uID p papID pc) = Some confID"
|
"uConfOfA (uPref confID uID p papID pr) = Some confID"
|
"uConfOfA (uReview confID uID p papID n rc) = Some confID"

fun uuConfOfA :: "uuAct â confID option" where
"uuConfOfA (uuNews confID uID p ev) = Some confID"
|
"uuConfOfA (uuDis confID uID p papID comm) = Some confID"
|
"uuConfOfA (uuReview confID uID p papID n rc) = Some confID"
|
"uuConfOfA (uuDec confID uID p papID dec) = Some confID"

fun rConfOfA :: "rAct â confID option" where
"rConfOfA (rAmIVoronkov uID p) = None"
|
"rConfOfA (rUser uID p uID') = None"
|
"rConfOfA (rConf confID uID p) = Some confID"
|
"rConfOfA (rNews confID uID p) = Some confID"
|
"rConfOfA (rPaperTAA confID uID p papID) = Some confID"
|
"rConfOfA (rPaperC confID uID p papID) = Some confID"
|
"rConfOfA (rPref confID uID p papID) = Some confID"
|
"rConfOfA (rMyReview confID uID p papID) = Some confID"
|
"rConfOfA (rReviews confID uID p papID) = Some confID"
|
"rConfOfA (rDecs confID uID p papID) = Some confID"
|
"rConfOfA (rDis confID uID p papID) = Some confID"
|
"rConfOfA (rFinalReviews confID uID p papID) = Some confID"
|
"rConfOfA (rFinalDec confID uID p papID) = Some confID"
|
"rConfOfA (rPrefOfPC confID uID p papID uID') = Some confID"


fun lConfOfA :: "lAct â confID option" where
"lConfOfA (lConfs uID p) = None"
|
"lConfOfA (lAConfs uID p) = None"
|
"lConfOfA (lSConfs uID p) = None"
|
"lConfOfA (lMyConfs uID p) = None"
|
"lConfOfA (lAllUsers uID p) = None"
|
"lConfOfA (lAllPapers uID p) = None"
|
"lConfOfA (lPC confID uID p) = Some confID"
|
"lConfOfA (lChair confID uID p) = Some confID"
|
"lConfOfA (lPapers confID uID p) = Some confID"
|
"lConfOfA (lMyPapers confID uID p) = Some confID"
|
"lConfOfA (lMyAssignedPapers confID uID p) = Some confID"
|
"lConfOfA (lAssignedReviewers confID uID p papID) = Some confID"

fun confOfA :: "act â confID option" where
"confOfA (Cact ca) = cConfOfA ca"
|
"confOfA (Uact ua) = uConfOfA ua"
|
"confOfA (UUact uua) = uuConfOfA uua"
|
"confOfA (Ract ra) = rConfOfA ra"
|
"confOfA (Lact la) = lConfOfA la"


(* The paper of an action: *)
fun cPaperOfA :: "cAct â paperID option" where
"cPaperOfA (cUser uID p name info email) = None"
|
"cPaperOfA (cPaper confID uID p papID name info) = Some papID"
(* time when a paperID appears is an action bearing its ID *)
|
"cPaperOfA (cPC confID uID p uID') = None"
|
"cPaperOfA (cChair confID uID p uID') = None"
|
"cPaperOfA (cConf confID uID p name info) = None"
|
"cPaperOfA (cAuthor confID uID p papID uID') = Some papID"
|
"cPaperOfA (cConflict confID uID p papID uID') = Some papID"
|
"cPaperOfA (cReview confID uID p papID uID') = Some papID"

fun uPaperOfA :: "uAct â paperID option" where
"uPaperOfA (uUser uID p p' name info email) = None"
|
"uPaperOfA (uConfA confID uID p) = None"
|
"uPaperOfA (uPhase confID uID p ph) = None"
|
"uPaperOfA (uPaperTA confID uID p papID name info) = Some papID"
|
"uPaperOfA (uPaperC confID uID p papID pc) = Some papID"
|
"uPaperOfA (uPref confID uID p papID pr) = Some papID"
|
"uPaperOfA (uReview confID uID p papID n rc) = Some papID"

fun uuPaperOfA :: "uuAct â paperID option" where
"uuPaperOfA (uuNews confID uID p ev) = None"
|
"uuPaperOfA (uuDis confID uID p papID comm) = Some papID"
|
"uuPaperOfA (uuReview confID uID p papID n rc) = Some papID"
|
"uuPaperOfA (uuDec confID uID p papID dec) = Some papID"

fun rPaperOfA :: "rAct â paperID option" where
"rPaperOfA (rAmIVoronkov uID p) = None"
|
"rPaperOfA (rUser uID p uID') = None"
|
"rPaperOfA (rConf confID uID p) = None"
|
"rPaperOfA (rNews confID uID p) = None"
|
"rPaperOfA (rPaperTAA confID uID p papID) = Some papID"
|
"rPaperOfA (rPaperC confID uID p papID) = Some papID"
|
"rPaperOfA (rPref confID uID p papID) = Some papID"
|
"rPaperOfA (rMyReview confID uID p papID) = Some papID"
|
"rPaperOfA (rReviews confID uID p papID) = Some papID"
|
"rPaperOfA (rDecs confID uID p papID) = Some papID"
|
"rPaperOfA (rDis confID uID p papID) = Some papID"
|
"rPaperOfA (rFinalReviews confID uID p papID) = Some papID"
|
"rPaperOfA (rFinalDec confID uID p papID) = Some papID"
|
"rPaperOfA (rPrefOfPC confID uID p papID uID') = Some papID"

fun lPaperOfA :: "lAct â paperID option" where
"lPaperOfA (lConfs uID p) = None"
|
"lPaperOfA (lAConfs uID p) = None"
|
"lPaperOfA (lSConfs uID p) = None"
|
"lPaperOfA (lMyConfs uID p) = None"
|
"lPaperOfA (lAllUsers uID p) = None"
|
"lPaperOfA (lAllPapers uID p) = None"
|
"lPaperOfA (lPC confID uID p) = None"
|
"lPaperOfA (lChair confID uID p) = None"
|
"lPaperOfA (lPapers confID uID p) = None"
|
"lPaperOfA (lMyPapers confID uID p) = None"
|
"lPaperOfA (lMyAssignedPapers confID uID p) = None"
|
"lPaperOfA (lAssignedReviewers confID uID p papID) = Some papID"

fun paperOfA :: "act â paperID option" where
"paperOfA (Cact ca) = cPaperOfA ca"
|
"paperOfA (Uact ua) = uPaperOfA ua"
|
"paperOfA (UUact uua) = uuPaperOfA uua"
|
"paperOfA (Ract ra) = rPaperOfA ra"
|
"paperOfA (Lact la) = lPaperOfA la"

(* Note: unlike confOfA and paperOfA which may be "None", userOfA always returns a user ID.  *)



end

Theory Safety_Properties

section â¹Safety propertiesâº

(* Verification of safety properties *)
theory Safety_Properties
imports Automation_Setup "Bounded_Deducibility_Security.IO_Automaton"
begin


(* Note that the safety properties are only concerned with the
step actions (creation, update and u-update) and their action on the state;
they have nothing to do with the observation actions.  *)


interpretation IO_Automaton where
istate = istate and step = step
done


subsection â¹Infrastructure for invariance reasoningâº

definition cIsInvar :: "(state â bool) â bool" where
"cIsInvar Ï â¡ â s ca. reach s â§ Ï s â¶ Ï (snd (cStep s ca))"

definition uIsInvar :: "(state â bool) â bool" where
"uIsInvar Ï â¡ â s ua. reach s â§ Ï s â¶ Ï (snd (uStep s ua))"

definition uuIsInvar :: "(state â bool) â bool" where
"uuIsInvar Ï â¡ â s uua. reach s â§ Ï s â¶ Ï (snd (uuStep s uua))"

(* for properties on states, of course the observations do not count: *)
lemma invar_cIsInvar_uIsInvar_uuIsInvar:
"invar Ï â· cIsInvar Ï â§ uIsInvar Ï â§ uuIsInvar Ï" (is "?L â· ?R")
unfolding invar_def cIsInvar_def uIsInvar_def uuIsInvar_def fun_eq_iff
  apply standard
  apply (metis snd_eqD step.simps)
  apply safe
  subgoal for _ a apply(cases a, auto) .
  done

lemma cIsInvar[case_names cUser cConf cPC cChair cPaper cAuthor cConflict cReview]:
assumes
"âs uID p name info email.
       â¦reach s; Ï s; e_createUser s uID p name info emailâ§
       â¹ Ï (createUser s uID p name info email)"
and
"âs confID uID p name info.
       â¦reach s; Ï s; e_createConf s confID uID p name infoâ§
       â¹ Ï (createConf s confID uID p name info)"
and
"âs confID uID p uID'.
       â¦reach s; Ï s; e_createPC s confID uID p uID'â§
       â¹ Ï (createPC s confID uID p uID')"
and
"âs confID uID p uID'.
       â¦reach s; Ï s; e_createChair s confID uID p uID'â§
       â¹ Ï (createChair s confID uID p uID')"
and
"âs confID uID p papID name info.
       â¦reach s; Ï s; e_createPaper s confID uID p papID name infoâ§
       â¹ Ï (createPaper s confID uID p papID name info)"
and
"âs confID uID p papID uID'.
       â¦reach s; Ï s; e_createAuthor s confID uID p papID uID'â§
       â¹ Ï (createAuthor s confID uID p papID uID')"
and
"âs confID uID p papID uID'.
       â¦reach s; Ï s; e_createConflict s confID uID p papID uID'â§
       â¹ Ï (createConflict s confID uID p papID uID')"
and
"âs confID uID p papID uID'.
       â¦reach s; Ï s; e_createReview s confID uID p papID uID'â§
       â¹ Ï (createReview s confID uID p papID uID')"
shows "cIsInvar Ï"
unfolding cIsInvar_def apply safe subgoal for _ ca using assms by (cases ca, auto) .

lemma uIsInvar[case_names uUser uConfA uNextPhase uPaperTA uPaperC uPref uReview]:
assumes
"âs uID p p' name info email.
       â¦reach s; Ï s; e_updateUser s uID p p' name info emailâ§
       â¹ Ï (updateUser s uID p p' name info email)"
 and
"âs confID uID p.
       â¦reach s; Ï s; e_updateConfA s confID uID pâ§ â¹ Ï (updateConfA s confID uID p)"
and
"âs confID uID p ph.
       â¦reach s; Ï s; e_updatePhase s confID uID p phâ§ â¹ Ï (updatePhase s confID uID p ph)"
and
"âs confID uID p paperID name info.
       â¦reach s; Ï s; e_updatePaperTA s confID uID p paperID name infoâ§
       â¹ Ï (updatePaperTA s confID uID p paperID name info)"
and
"âs confID uID p paperID pc.
       â¦reach s; Ï s; e_updatePaperC s confID uID p paperID pcâ§
       â¹ Ï (updatePaperC s confID uID p paperID pc)"
and
"âs confID uID p paperID preference.
       â¦reach s; Ï s; e_updatePref s confID uID p paperID preferenceâ§
       â¹ Ï (updatePref s confID uID p paperID preference)"
and
"âs confID uID p paperID n rc.
       â¦reach s; Ï s; e_updateReview s confID uID p paperID n rcâ§
       â¹ Ï (updateReview s confID uID p paperID n rc)"
and
"âs confID uID p paperID fpc.
       â¦reach s; Ï s; e_updateFPaperC s confID uID p paperID fpcâ§
       â¹ Ï (updateFPaperC s confID uID p paperID fpc)"
shows "uIsInvar Ï"
unfolding uIsInvar_def apply safe using assms subgoal for _ ua by (cases ua, auto) .

lemma uuIsInvar[case_names uuNews uuDis uuReview uuDec]:
assumes
"âs confID uID p comm.
       â¦reach s; Ï s; e_uupdateNews s confID uID p commâ§
       â¹ Ï (uupdateNews s confID uID p comm)"
and
"âs confID uID p paperID comm.
       â¦reach s; Ï s; e_uupdateDis s confID uID p paperID commâ§
       â¹ Ï (uupdateDis s confID uID p paperID comm)"
and
"âs confID uID p paperID n rc.
       â¦reach s; Ï s; e_uupdateReview s confID uID p paperID n rcâ§
       â¹ Ï (uupdateReview s confID uID p paperID n rc)"
and
"âs confID uID p paperID decision.
       â¦reach s; Ï s; e_uupdateDec s confID uID p paperID decisionâ§
       â¹ Ï (uupdateDec s confID uID p paperID decision)"
shows "uuIsInvar Ï"
unfolding uuIsInvar_def apply safe subgoal for _ uua using assms by (cases uua, auto) .


subsection â¹Safety proofsâº

(* Simplification and splitting setup: *)
declare option.splits[split] paper.splits[split] discussion.splits[split] role.splits[split]
        Let_def[simp] list_all_iff[simp] list_ex_iff[simp] fun_upd2_def[simp] IDsOK_def[simp]
        if_splits[split]


fun papIDsOfRole where
"papIDsOfRole (Aut papID) = [papID]"
|
"papIDsOfRole (Rev papID n) = [papID]"
|
"papIDsOfRole _ = []"

(* The phase is always â¤ closedPH: *)
definition phase_leq_closedPH :: "state â bool" where
"phase_leq_closedPH s â¡
 â confID. phase s confID â¤ closedPH"

lemma holdsIstate_phase_leq_closedPH: "holdsIstate phase_leq_closedPH"
unfolding IO_Automaton.holdsIstate_def istate_def phase_leq_closedPH_def by auto

lemma cIsInvar_phase_leq_closedPH: "cIsInvar phase_leq_closedPH"
apply (cases phase_leq_closedPH rule: cIsInvar)
by (auto simp: c_defs phase_leq_closedPH_def)

lemma uIsInvar_phase_leq_closedPH: "uIsInvar phase_leq_closedPH"
apply (cases phase_leq_closedPH rule: uIsInvar)
by (auto simp: u_defs phase_leq_closedPH_def)

lemma uuIsInvar_phase_leq_closedPH: "uuIsInvar phase_leq_closedPH"
apply (cases phase_leq_closedPH rule: uuIsInvar)
by (auto simp: uu_defs phase_leq_closedPH_def)

lemma invar_phase_leq_closedPH: "invar phase_leq_closedPH"
unfolding invar_cIsInvar_uIsInvar_uuIsInvar
using cIsInvar_phase_leq_closedPH uIsInvar_phase_leq_closedPH uuIsInvar_phase_leq_closedPH by auto

lemmas phase_leq_closedPH1 =
holdsIstate_invar[OF holdsIstate_phase_leq_closedPH invar_phase_leq_closedPH]

theorem phase_leq_closedPH:
assumes a: "reach s"
shows "phase s confID â¤ closedPH"
using phase_leq_closedPH1[OF a] unfolding phase_leq_closedPH_def by auto

(* A conference ID exsists if its phase is > noPH: *)
definition geq_noPH_confIDs :: "state â bool" where
"geq_noPH_confIDs s â¡
 â confID. phase s confID > noPH â¶ confID ââ confIDs s"

lemma holdsIstate_geq_noPH_confIDs: "holdsIstate geq_noPH_confIDs"
unfolding IO_Automaton.holdsIstate_def istate_def istate_def geq_noPH_confIDs_def by auto

lemma cIsInvar_geq_noPH_confIDs: "cIsInvar geq_noPH_confIDs"
apply (cases geq_noPH_confIDs rule: cIsInvar)
by (auto simp: c_defs geq_noPH_confIDs_def)

lemma uIsInvar_geq_noPH_confIDs: "uIsInvar geq_noPH_confIDs"
apply (cases geq_noPH_confIDs rule: uIsInvar)
by (auto simp: u_defs geq_noPH_confIDs_def)

lemma uuIsInvar_geq_noPH_confIDs: "uuIsInvar geq_noPH_confIDs"
apply (cases geq_noPH_confIDs rule: uuIsInvar)
by (auto simp: uu_defs geq_noPH_confIDs_def)

lemma invar_geq_noPH_confIDs: "invar geq_noPH_confIDs"
unfolding invar_cIsInvar_uIsInvar_uuIsInvar
using cIsInvar_geq_noPH_confIDs uIsInvar_geq_noPH_confIDs uuIsInvar_geq_noPH_confIDs by auto

lemmas geq_noPH_confIDs1 =
holdsIstate_invar[OF holdsIstate_geq_noPH_confIDs invar_geq_noPH_confIDs]

theorem geq_noPH_confIDs:
assumes a: "reach s"
shows "phase s confID > noPH â¶ confID ââ confIDs s"
using geq_noPH_confIDs1[OF a] unfolding geq_noPH_confIDs_def by auto

(* All the IDs involved in the "roles" relation are valid IDs of the system: *)
definition roles_IDsOK :: "state â bool" where
"roles_IDsOK s â¡
 â confID uID rl.
   rl ââ roles s confID uID â¶ IDsOK s [confID] [uID] (papIDsOfRole rl)"

lemma holdsIstate_roles_IDsOK: "holdsIstate roles_IDsOK"
unfolding IO_Automaton.holdsIstate_def istate_def istate_def roles_IDsOK_def by auto

lemma cIsInvar_roles_IDsOK: "cIsInvar roles_IDsOK"
apply (cases roles_IDsOK rule: cIsInvar)
by (auto simp: c_defs roles_IDsOK_def)

lemma uIsInvar_roles_IDsOK: "uIsInvar roles_IDsOK"
apply (cases roles_IDsOK rule: uIsInvar)
by (auto simp: u_defs roles_IDsOK_def)

lemma uuIsInvar_roles_IDsOK: "uuIsInvar roles_IDsOK"
apply (cases roles_IDsOK rule: uuIsInvar)
by (auto simp: uu_defs roles_IDsOK_def)

lemma invar_roles_IDsOK: "invar roles_IDsOK"
unfolding invar_cIsInvar_uIsInvar_uuIsInvar
using cIsInvar_roles_IDsOK uIsInvar_roles_IDsOK uuIsInvar_roles_IDsOK by auto

lemmas roles_IDsOK1 =
holdsIstate_invar[OF holdsIstate_roles_IDsOK invar_roles_IDsOK]

theorem roles_IDsOK:
assumes a: "reach s" and rl: "rl ââ roles s confID uID"
shows "IDsOK s [confID] [uID] (papIDsOfRole rl)"
using roles_IDsOK1[OF a] rl unfolding roles_IDsOK_def by auto

corollary roles_confIDs:
assumes a: "reach s" and A: "rl ââ roles s confID uID"
shows "confID ââ confIDs s"
using roles_IDsOK[OF a] A unfolding IDsOK_def by auto

corollary roles_userIDs:
assumes a: "reach s" and A: "rl ââ roles s confID uID"
shows "uID ââ userIDs s"
using roles_IDsOK[OF a] A unfolding IDsOK_def by auto

corollary isAut_paperIDs:
assumes a: "reach s" and A: "isAut s confID uID papID"
shows "papID ââ paperIDs s confID"
using roles_IDsOK[OF a] A unfolding IDsOK_def by auto

corollary isRevNth_paperIDs:
assumes a: "reach s" and A: "isRevNth s confID uID papID n"
shows "papID ââ paperIDs s confID"
using roles_IDsOK[OF a] A unfolding IDsOK_def by auto

corollary isRev_paperIDs:
assumes a: "reach s" and A: "isRev s confID uID papID"
shows "papID ââ paperIDs s confID"
using isRevNth_paperIDs[OF a] A unfolding isRev_def2 by auto

corollary isRev_userIDs:
assumes a: "reach s" and A: "isRev s confID uID papID"
shows "uID ââ userIDs s"
using roles_userIDs[OF a] A unfolding isRev_def2 by auto

corollary isRev_confIDs:
assumes a: "reach s" and A: "isRev s confID uID papID"
shows "confID ââ confIDs s"
using roles_confIDs[OF a] A unfolding isRev_def2 by auto

(* The lists of (conference, user and paper) IDs are non-repetitive *)
definition distinct_IDs :: "state â bool" where
"distinct_IDs s â¡
 distinct (confIDs s) â§ distinct (userIDs s) â§ (â confID. distinct (paperIDs s confID))"

lemma holdsIstate_distinct_IDs: "holdsIstate distinct_IDs"
unfolding IO_Automaton.holdsIstate_def istate_def istate_def distinct_IDs_def by auto

lemma cIsInvar_distinct_IDs: "cIsInvar distinct_IDs"
apply (cases distinct_IDs rule: cIsInvar)
by (auto simp: c_defs distinct_IDs_def getAllPaperIDs_def)

lemma uIsInvar_distinct_IDs: "uIsInvar distinct_IDs"
apply (cases distinct_IDs rule: uIsInvar)
by (auto simp: u_defs distinct_IDs_def)

lemma uuIsInvar_distinct_IDs: "uuIsInvar distinct_IDs"
apply (cases distinct_IDs rule: uuIsInvar)
by (auto simp: uu_defs distinct_IDs_def)

lemma invar_distinct_IDs: "invar distinct_IDs"
unfolding invar_cIsInvar_uIsInvar_uuIsInvar
using cIsInvar_distinct_IDs uIsInvar_distinct_IDs uuIsInvar_distinct_IDs by auto

lemmas distinct_IDs1 = holdsIstate_invar[OF holdsIstate_distinct_IDs invar_distinct_IDs]

theorem distinct_IDs:
assumes a: "reach s"
shows "distinct (confIDs s) â§ distinct (userIDs s) â§ (â confID. distinct (paperIDs s confID))"
using distinct_IDs1[OF a] unfolding distinct_IDs_def by auto

lemmas distinct_confIDs = distinct_IDs[THEN conjunct1]
lemmas distinct_userIDs = distinct_IDs[THEN conjunct2, THEN conjunct1]
lemmas distinct_paperIDs = distinct_IDs[THEN conjunct2, THEN conjunct2, rule_format]

(* The list of roles of a user at a conference is non-repetitive *)
definition distinct_roles :: "state â bool" where
"distinct_roles s â¡
 â confID uID. distinct (roles s confID uID)"

lemma holdsIstate_distinct_roles: "holdsIstate distinct_roles"
unfolding IO_Automaton.holdsIstate_def istate_def istate_def distinct_roles_def by auto

lemma cIsInvar_distinct_roles: "cIsInvar distinct_roles"
apply (cases distinct_roles rule: cIsInvar)
by (auto simp: c_defs distinct_roles_def)

lemma uIsInvar_distinct_roles: "uIsInvar distinct_roles"
apply (cases distinct_roles rule: uIsInvar)
by (auto simp: u_defs distinct_roles_def)

lemma uuIsInvar_distinct_roles: "uuIsInvar distinct_roles"
apply (cases distinct_roles rule: uuIsInvar)
by (auto simp: uu_defs distinct_roles_def)

lemma invar_distinct_roles: "invar distinct_roles"
unfolding invar_cIsInvar_uIsInvar_uuIsInvar
using cIsInvar_distinct_roles uIsInvar_distinct_roles uuIsInvar_distinct_roles by auto

lemmas distinct_roles1 = holdsIstate_invar[OF holdsIstate_distinct_roles invar_distinct_roles]

theorem distinct_roles:
assumes a: "reach s"
shows "distinct (roles s confID uID)"
using distinct_roles1[OF a] unfolding distinct_roles_def by auto

(* Only committee members become reviewers: *)
definition isRevNth_isPC :: "state â bool" where
"isRevNth_isPC s â¡
 â confID uID papID n. isRevNth s confID uID papID n â¶ isPC s confID uID"

lemma holdsIstate_isRevNth_isPC: "holdsIstate isRevNth_isPC"
unfolding IO_Automaton.holdsIstate_def istate_def istate_def isRevNth_isPC_def by auto

lemma cIsInvar_isRevNth_isPC: "cIsInvar isRevNth_isPC"
apply (cases isRevNth_isPC rule: cIsInvar)
by (auto simp: c_defs isRevNth_isPC_def)

lemma uIsInvar_isRevNth_isPC: "uIsInvar isRevNth_isPC"
apply (cases isRevNth_isPC rule: uIsInvar)
by (auto simp: u_defs isRevNth_isPC_def)

lemma uuIsInvar_isRevNth_isPC: "uuIsInvar isRevNth_isPC"
apply (cases isRevNth_isPC rule: uuIsInvar)
by (auto simp: uu_defs isRevNth_isPC_def)

lemma invar_isRevNth_isPC: "invar isRevNth_isPC"
unfolding invar_cIsInvar_uIsInvar_uuIsInvar
using cIsInvar_isRevNth_isPC uIsInvar_isRevNth_isPC uuIsInvar_isRevNth_isPC by auto

lemmas isRevNth_isPC1 = holdsIstate_invar[OF holdsIstate_isRevNth_isPC invar_isRevNth_isPC]

theorem isRevNth_isPC:
assumes a: "reach s" and R: "isRevNth s confID uID papID n"
shows "isPC s confID uID"
using isRevNth_isPC1[OF a] R unfolding isRevNth_isPC_def by auto

corollary isRev_isPC:
assumes a: "reach s" and R: "isRev s confID uID papID"
shows "isPC s confID uID"
using isRevNth_isPC[OF a] R unfolding isRev_def2 by auto

(* Every conference that has papers is registered: *)
definition paperIDs_confIDs :: "state â bool" where
"paperIDs_confIDs s â¡
 â confID papID.
    papID ââ paperIDs s confID â¶ confID ââ confIDs s"

lemma holdsIstate_paperIDs_confIDs: "holdsIstate paperIDs_confIDs"
unfolding IO_Automaton.holdsIstate_def istate_def istate_def paperIDs_confIDs_def by auto

lemma cIsInvar_paperIDs_confIDs: "cIsInvar paperIDs_confIDs"
apply (cases paperIDs_confIDs rule: cIsInvar)
by (auto simp: c_defs paperIDs_confIDs_def )

lemma uIsInvar_paperIDs_confIDs: "uIsInvar paperIDs_confIDs"
apply (cases paperIDs_confIDs rule: uIsInvar)
by (auto simp: u_defs paperIDs_confIDs_def)

lemma uuIsInvar_paperIDs_confIDs: "uuIsInvar paperIDs_confIDs"
apply (cases paperIDs_confIDs rule: uuIsInvar)
by (auto simp: uu_defs paperIDs_confIDs_def)

lemma invar_paperIDs_confIDs: "invar paperIDs_confIDs"
unfolding invar_cIsInvar_uIsInvar_uuIsInvar
using cIsInvar_paperIDs_confIDs uIsInvar_paperIDs_confIDs uuIsInvar_paperIDs_confIDs by auto

lemmas paperIDs_confIDs1 = holdsIstate_invar[OF holdsIstate_paperIDs_confIDs invar_paperIDs_confIDs]

theorem paperIDs_confIDs:
assumes a: "reach s" and p: "papID ââ paperIDs s confID"
shows "confID ââ confIDs s"
using paperIDs_confIDs1[OF a] p  unfolding paperIDs_confIDs_def by auto

corollary paperIDs_getAllPaperIDs:
assumes a: "reach s" and p: "papID ââ paperIDs s confID"
shows "papID ââ getAllPaperIDs s"
using paperIDs_confIDs[OF assms] p unfolding getAllPaperIDs_def by auto

corollary isRevNth_getAllPaperIDs:
assumes a: "reach s" and "isRevNth s confID uID papID n"
shows "papID ââ getAllPaperIDs s"
using paperIDs_getAllPaperIDs[OF a isRevNth_paperIDs[OF assms]] .

(* No paper is registered at two conferences: *)
definition paperIDs_equals :: "state â bool" where
"paperIDs_equals s â¡
 â confID1 confID2 papID.
    papID ââ paperIDs s confID1 â§ papID ââ paperIDs s confID2
    â¶ confID1 = confID2"

lemma holdsIstate_paperIDs_equals: "holdsIstate paperIDs_equals"
unfolding IO_Automaton.holdsIstate_def istate_def istate_def paperIDs_equals_def by auto

lemma cIsInvar_paperIDs_equals: "cIsInvar paperIDs_equals"
apply (cases paperIDs_equals rule: cIsInvar)
by (auto simp: c_defs paperIDs_equals_def paperIDs_getAllPaperIDs)

lemma uIsInvar_paperIDs_equals: "uIsInvar paperIDs_equals"
apply (cases paperIDs_equals rule: uIsInvar)
by (auto simp: u_defs paperIDs_equals_def)

lemma uuIsInvar_paperIDs_equals: "uuIsInvar paperIDs_equals"
apply (cases paperIDs_equals rule: uuIsInvar)
by (auto simp: uu_defs paperIDs_equals_def)

lemma invar_paperIDs_equals: "invar paperIDs_equals"
unfolding invar_cIsInvar_uIsInvar_uuIsInvar
using cIsInvar_paperIDs_equals uIsInvar_paperIDs_equals uuIsInvar_paperIDs_equals by auto

lemmas paperIDs_equals1 = holdsIstate_invar[OF holdsIstate_paperIDs_equals invar_paperIDs_equals]

theorem paperIDs_equals:
assumes a: "reach s" and p: "papID ââ paperIDs s confID1" "papID ââ paperIDs s confID2"
shows "confID1 = confID2"
using paperIDs_equals1[OF a] p unfolding paperIDs_equals_def by auto

(* Everybody has conflict with their own papers *)
definition isAut_pref_Conflict :: "state â bool" where
"isAut_pref_Conflict s â¡
 â confID uID papID. isAut s confID uID papID â¶ pref s uID papID = Conflict"

lemma holdsIstate_isAut_pref_Conflict: "holdsIstate isAut_pref_Conflict"
unfolding IO_Automaton.holdsIstate_def istate_def istate_def isAut_pref_Conflict_def by auto

lemma cIsInvar_isAut_pref_Conflict: "cIsInvar isAut_pref_Conflict"
apply (cases isAut_pref_Conflict rule: cIsInvar)
by (auto simp: c_defs isAut_pref_Conflict_def)

lemma uIsInvar_isAut_pref_Conflict: "uIsInvar isAut_pref_Conflict"
proof(cases isAut_pref_Conflict rule: uIsInvar)
  case (uPref s confID uID p paperID preference)
  thus ?case apply (auto simp: u_defs isAut_pref_Conflict_def)
  apply(frule isAut_paperIDs, simp)
  apply(frule paperIDs_equals, simp, simp, fastforce)
  done
qed (auto simp: u_defs isAut_pref_Conflict_def)

lemma uuIsInvar_isAut_pref_Conflict: "uuIsInvar isAut_pref_Conflict"
apply (cases isAut_pref_Conflict rule: uuIsInvar)
by (auto simp: uu_defs isAut_pref_Conflict_def)

lemma invar_isAut_pref_Conflict: "invar isAut_pref_Conflict"
unfolding invar_cIsInvar_uIsInvar_uuIsInvar
using cIsInvar_isAut_pref_Conflict uIsInvar_isAut_pref_Conflict
uuIsInvar_isAut_pref_Conflict by auto

lemmas isAut_pref_Conflict1 =
holdsIstate_invar[OF holdsIstate_isAut_pref_Conflict invar_isAut_pref_Conflict]

theorem isAut_pref_Conflict:
assumes a: "reach s" and i: "isAut s confID uID papID"
shows "pref s uID papID = Conflict"
using isAut_pref_Conflict1[OF a] i unfolding isAut_pref_Conflict_def by auto

(* A conference in phase noPH has no assigned papers  *)
definition phase_noPH_paperIDs :: "state â bool" where
"phase_noPH_paperIDs s â¡
 â confID. phase s confID = noPH â¶ paperIDs s confID = []"

lemma holdsIstate_phase_noPH_paperIDs: "holdsIstate phase_noPH_paperIDs"
unfolding IO_Automaton.holdsIstate_def istate_def istate_def phase_noPH_paperIDs_def by auto

lemma cIsInvar_phase_noPH_paperIDs: "cIsInvar phase_noPH_paperIDs"
apply (cases phase_noPH_paperIDs rule: cIsInvar)
by (auto simp: c_defs phase_noPH_paperIDs_def)

lemma uIsInvar_phase_noPH_paperIDs: "uIsInvar phase_noPH_paperIDs"
apply(cases phase_noPH_paperIDs rule: uIsInvar)
by (auto simp: u_defs phase_noPH_paperIDs_def)

lemma uuIsInvar_phase_noPH_paperIDs: "uuIsInvar phase_noPH_paperIDs"
apply (cases phase_noPH_paperIDs rule: uuIsInvar)
by (auto simp: uu_defs phase_noPH_paperIDs_def)

lemma invar_phase_noPH_paperIDs: "invar phase_noPH_paperIDs"
unfolding invar_cIsInvar_uIsInvar_uuIsInvar
using cIsInvar_phase_noPH_paperIDs uIsInvar_phase_noPH_paperIDs
uuIsInvar_phase_noPH_paperIDs by auto

lemmas phase_noPH_paperIDs1 =
holdsIstate_invar[OF holdsIstate_phase_noPH_paperIDs invar_phase_noPH_paperIDs]

theorem phase_noPH_paperIDs:
assumes a: "reach s" and p: "phase s confID = noPH"
shows "paperIDs s confID = []"
using phase_noPH_paperIDs1[OF a] p unfolding phase_noPH_paperIDs_def by auto

(* Papers only exist starting from the submission phase: *)
definition paperIDs_geq_subPH :: "state â bool" where
"paperIDs_geq_subPH s â¡
 â confID papID. papID ââ paperIDs s confID â¶ phase s confID â¥ subPH"

lemma holdsIstate_paperIDs_geq_subPH: "holdsIstate paperIDs_geq_subPH"
unfolding IO_Automaton.holdsIstate_def istate_def istate_def paperIDs_geq_subPH_def by auto

lemma cIsInvar_paperIDs_geq_subPH: "cIsInvar paperIDs_geq_subPH"
apply (cases paperIDs_geq_subPH rule: cIsInvar)
by (auto simp: c_defs paperIDs_geq_subPH_def)

lemma uIsInvar_paperIDs_geq_subPH: "uIsInvar paperIDs_geq_subPH"
apply (cases paperIDs_geq_subPH rule: uIsInvar)
by (fastforce simp: u_defs paperIDs_geq_subPH_def)+

lemma uuIsInvar_paperIDs_geq_subPH: "uuIsInvar paperIDs_geq_subPH"
apply (cases paperIDs_geq_subPH rule: uuIsInvar)
by (auto simp: uu_defs paperIDs_geq_subPH_def)

lemma invar_paperIDs_geq_subPH: "invar paperIDs_geq_subPH"
unfolding invar_cIsInvar_uIsInvar_uuIsInvar
using cIsInvar_paperIDs_geq_subPH uIsInvar_paperIDs_geq_subPH
uuIsInvar_paperIDs_geq_subPH by auto

lemmas paperIDs_geq_subPH1 =
holdsIstate_invar[OF holdsIstate_paperIDs_geq_subPH invar_paperIDs_geq_subPH]

theorem paperIDs_geq_subPH:
assumes a: "reach s" and i: "papID ââ paperIDs s confID"
shows "phase s confID â¥ subPH"
using paperIDs_geq_subPH1[OF a] i unfolding paperIDs_geq_subPH_def by auto

(* Reviewers only exist starting from the reviewing phase: *)
definition isRevNth_geq_revPH :: "state â bool" where
"isRevNth_geq_revPH s â¡
 â confID uID papID n. isRevNth s confID uID papID n â¶ phase s confID â¥ revPH"

lemma holdsIstate_isRevNth_geq_revPH: "holdsIstate isRevNth_geq_revPH"
unfolding IO_Automaton.holdsIstate_def istate_def istate_def isRevNth_geq_revPH_def by auto

lemma cIsInvar_isRevNth_geq_revPH: "cIsInvar isRevNth_geq_revPH"
apply (cases isRevNth_geq_revPH rule: cIsInvar)
by (auto simp: c_defs isRevNth_geq_revPH_def)

lemma uIsInvar_isRevNth_geq_revPH: "uIsInvar isRevNth_geq_revPH"
proof (cases isRevNth_geq_revPH rule: uIsInvar)
  case (uConfA s confID uID p) thus ?case
  by (fastforce simp: u_defs isRevNth_geq_revPH_def)
qed(fastforce simp: u_defs isRevNth_geq_revPH_def)+

lemma uuIsInvar_isRevNth_geq_revPH: "uuIsInvar isRevNth_geq_revPH"
apply (cases isRevNth_geq_revPH rule: uuIsInvar)
by (auto simp: uu_defs isRevNth_geq_revPH_def)

lemma invar_isRevNth_geq_revPH: "invar isRevNth_geq_revPH"
unfolding invar_cIsInvar_uIsInvar_uuIsInvar
using cIsInvar_isRevNth_geq_revPH uIsInvar_isRevNth_geq_revPH
uuIsInvar_isRevNth_geq_revPH by auto

lemmas isRevNth_geq_revPH1 =
holdsIstate_invar[OF holdsIstate_isRevNth_geq_revPH invar_isRevNth_geq_revPH]

theorem isRevNth_geq_revPH:
assumes a: "reach s" and i: "isRevNth s confID uID papID n"
shows "phase s confID â¥ revPH"
using isRevNth_geq_revPH1[OF a] i unfolding isRevNth_geq_revPH_def by auto

corollary isRev_geq_revPH:
assumes a: "reach s" and i: "isRev s confID uID papID"
shows "phase s confID â¥ revPH"
using isRevNth_geq_revPH[OF a] i unfolding isRev_def2 by auto

(* Every paper has at least one author: *)
definition paperID_ex_userID :: "state â bool" where
"paperID_ex_userID s â¡
 â confID papID. papID ââ paperIDs s confID â¶ (â uID. isAut s confID uID papID)"

lemma holdsIstate_paperID_ex_userID: "holdsIstate paperID_ex_userID"
unfolding IO_Automaton.holdsIstate_def istate_def istate_def paperID_ex_userID_def by auto

lemma cIsInvar_paperID_ex_userID: "cIsInvar paperID_ex_userID"
apply (cases paperID_ex_userID rule: cIsInvar)
by (fastforce simp: c_defs paperID_ex_userID_def paperIDs_confIDs)+

lemma uIsInvar_paperID_ex_userID: "uIsInvar paperID_ex_userID"
apply (cases paperID_ex_userID rule: uIsInvar)
by (fastforce simp: u_defs paperID_ex_userID_def)+

lemma uuIsInvar_paperID_ex_userID: "uuIsInvar paperID_ex_userID"
apply (cases paperID_ex_userID rule: uuIsInvar)
by (auto simp: uu_defs paperID_ex_userID_def)

lemma invar_paperID_ex_userID: "invar paperID_ex_userID"
unfolding invar_cIsInvar_uIsInvar_uuIsInvar
using cIsInvar_paperID_ex_userID uIsInvar_paperID_ex_userID
uuIsInvar_paperID_ex_userID by auto

lemmas paperID_ex_userID1 =
holdsIstate_invar[OF holdsIstate_paperID_ex_userID invar_paperID_ex_userID]

theorem paperID_ex_userID:
assumes a: "reach s" and i: "papID ââ paperIDs s confID"
shows "â uID. isAut s confID uID papID"
using paperID_ex_userID1[OF a] i unfolding paperID_ex_userID_def by auto

(* Nobody reviews a paper with which one has conflict: *)
definition pref_Conflict_isRevNth :: "state â bool" where
"pref_Conflict_isRevNth s â¡
 â confID uID papID n. pref s uID papID = Conflict â¶ Â¬ isRevNth s confID uID papID n"

lemma holdsIstate_pref_Conflict_isRevNth: "holdsIstate pref_Conflict_isRevNth"
unfolding IO_Automaton.holdsIstate_def istate_def istate_def pref_Conflict_isRevNth_def by auto

lemma cIsInvar_pref_Conflict_isRevNth: "cIsInvar pref_Conflict_isRevNth"
proof (cases pref_Conflict_isRevNth rule: cIsInvar)
  case (cAuthor s confID uID p papID uID') thus ?case
  apply (auto simp: c_defs pref_Conflict_isRevNth_def)
  apply(frule isRevNth_geq_revPH, simp, simp)
  apply(frule isRevNth_paperIDs, simp)
  apply(frule paperIDs_equals, simp, simp, force)
  done
next
  case (cConflict  s confID uID p papID uID') thus ?case
  apply (auto simp: c_defs pref_Conflict_isRevNth_def)
  apply(frule isRevNth_geq_revPH, simp)
  apply(frule isRevNth_paperIDs, simp)
  apply(frule paperIDs_equals, simp, simp, force)
  done
qed (auto simp: c_defs pref_Conflict_isRevNth_def isRevNth_getAllPaperIDs)

lemma uIsInvar_pref_Conflict_isRevNth: "uIsInvar pref_Conflict_isRevNth"
proof(cases pref_Conflict_isRevNth rule: uIsInvar)
  case (uPref s confID uID p paperID pref) thus ?case
  apply (auto simp: u_defs pref_Conflict_isRevNth_def)
  apply(frule isRevNth_geq_revPH, simp)
  apply(frule isRevNth_paperIDs, simp)
  apply(frule paperIDs_equals, simp, simp, force)
  done
qed (auto simp: u_defs pref_Conflict_isRevNth_def)

lemma uuIsInvar_pref_Conflict_isRevNth: "uuIsInvar pref_Conflict_isRevNth"
apply (cases pref_Conflict_isRevNth rule: uuIsInvar)
by (auto simp: uu_defs pref_Conflict_isRevNth_def)

lemma invar_pref_Conflict_isRevNth: "invar pref_Conflict_isRevNth"
unfolding invar_cIsInvar_uIsInvar_uuIsInvar
using cIsInvar_pref_Conflict_isRevNth uIsInvar_pref_Conflict_isRevNth uuIsInvar_pref_Conflict_isRevNth by auto

lemmas pref_Conflict_isRevNth1 =
holdsIstate_invar[OF holdsIstate_pref_Conflict_isRevNth invar_pref_Conflict_isRevNth]

theorem pref_Conflict_isRevNth:
assumes a: "reach s" and i: "pref s uID papID = Conflict"
shows "Â¬ isRevNth s confID uID papID n"
using pref_Conflict_isRevNth1[OF a] i unfolding pref_Conflict_isRevNth_def by auto

corollary pref_Conflict_isRev:
assumes a: "reach s" and i: "pref s uID papID = Conflict"
shows "Â¬ isRev s confID uID papID"
using pref_Conflict_isRevNth[OF a] i unfolding isRev_def2 by auto

(* Nobody reviews her own paper: *)
corollary pref_isAut_isRevNth:
assumes a: "reach s" and i: "isAut s confID uID papID"
shows "Â¬ isRevNth s confID uID papID n"
using pref_Conflict_isRevNth[OF a] isAut_pref_Conflict[OF a i] by auto

corollary pref_isAut_isRev:
assumes a: "reach s" and i: "isAut s confID uID papID"
shows "Â¬ isRev s confID uID papID"
using pref_isAut_isRevNth[OF a] i unfolding isRev_def2 by auto

(* Every chair is also a committee member *)
definition isChair_isPC :: "state â bool" where
"isChair_isPC s â¡
 â confID uID. isChair s confID uID â¶ isPC s confID uID"

lemma holdsIstate_isChair_isPC: "holdsIstate isChair_isPC"
unfolding IO_Automaton.holdsIstate_def istate_def istate_def isChair_isPC_def by auto

lemma cIsInvar_isChair_isPC: "cIsInvar isChair_isPC"
apply (cases isChair_isPC rule: cIsInvar)
by (auto simp: c_defs isChair_isPC_def)

lemma uIsInvar_isChair_isPC: "uIsInvar isChair_isPC"
apply(cases isChair_isPC rule: uIsInvar)
by (auto simp: u_defs isChair_isPC_def)

lemma uuIsInvar_isChair_isPC: "uuIsInvar isChair_isPC"
apply (cases isChair_isPC rule: uuIsInvar)
by (auto simp: uu_defs isChair_isPC_def)

lemma invar_isChair_isPC: "invar isChair_isPC"
unfolding invar_cIsInvar_uIsInvar_uuIsInvar
using cIsInvar_isChair_isPC uIsInvar_isChair_isPC
uuIsInvar_isChair_isPC by auto

lemmas isChair_isPC1 =
holdsIstate_invar[OF holdsIstate_isChair_isPC invar_isChair_isPC]

theorem isChair_isPC:
assumes a: "reach s" and p: "isChair s confID uID"
shows "isPC s confID uID"
using isChair_isPC1[OF a] p unfolding isChair_isPC_def by auto

(* A user does not get to write more than one review of any given paper: *)
definition isRevNth_equals :: "state â bool" where
"isRevNth_equals s â¡
 â confID uID papID m n.
    isRevNth s confID uID papID m â§ isRevNth s confID uID papID n
    â¶ m = n"

lemma holdsIstate_isRevNth_equals: "holdsIstate isRevNth_equals"
unfolding IO_Automaton.holdsIstate_def istate_def istate_def isRevNth_equals_def by auto

lemma cIsInvar_isRevNth_equals: "cIsInvar isRevNth_equals"
proof (cases isRevNth_equals rule: cIsInvar)
(* this case is merely singled out for documentation: *)
  case (cReview s confID uID p papID uID')
  thus ?case by(fastforce simp add: c_defs isRevNth_equals_def isRev_def2)
qed (auto simp: c_defs isRevNth_equals_def)

lemma uIsInvar_isRevNth_equals: "uIsInvar isRevNth_equals"
apply(cases isRevNth_equals rule: uIsInvar)
by (auto simp: u_defs isRevNth_equals_def)

lemma uuIsInvar_isRevNth_equals: "uuIsInvar isRevNth_equals"
apply (cases isRevNth_equals rule: uuIsInvar)
by (auto simp: uu_defs isRevNth_equals_def)

lemma invar_isRevNth_equals: "invar isRevNth_equals"
unfolding invar_cIsInvar_uIsInvar_uuIsInvar
using cIsInvar_isRevNth_equals uIsInvar_isRevNth_equals
uuIsInvar_isRevNth_equals by auto

lemmas isRevNth_equals1 =
holdsIstate_invar[OF holdsIstate_isRevNth_equals invar_isRevNth_equals]

theorem isRevNth_equals:
assumes a: "reach s" and r: "isRevNth s confID uID papID m" "isRevNth s confID uID papID n"
shows "m = n"
using isRevNth_equals1[OF a] r unfolding isRevNth_equals_def by blast

corollary isRevNth_getReviewIndex:
assumes a: "reach s" and r: "isRevNth s confID uID papID n"
shows "n = getReviewIndex s confID uID papID"
using isRevNth_equals[OF a r] r
by (metis isRev_def2 isRev_def3)


(* A reviewer is always assigned a valid review number: *)
definition isRevNth_less_length :: "state â bool" where
"isRevNth_less_length s â¡
 â confID uID papID n.
    isRevNth s confID uID papID n â¶ n < length (reviewsPaper (paper s papID))"

lemma holdsIstate_isRevNth_less_length: "holdsIstate isRevNth_less_length"
unfolding IO_Automaton.holdsIstate_def istate_def istate_def isRevNth_less_length_def by auto

lemma cIsInvar_isRevNth_less_length: "cIsInvar isRevNth_less_length"
apply(cases isRevNth_less_length rule: cIsInvar)
by(fastforce simp: c_defs isRevNth_less_length_def
isRevNth_getAllPaperIDs isRev_def2 isRevNth_paperIDs paperIDs_equals less_SucI)+

lemma uIsInvar_isRevNth_less_length: "uIsInvar isRevNth_less_length"
apply(cases isRevNth_less_length rule: uIsInvar)
by(fastforce simp: u_defs isRevNth_less_length_def
isRevNth_getAllPaperIDs isRev_def2 isRevNth_paperIDs paperIDs_equals less_SucI)+

lemma uuIsInvar_isRevNth_less_length: "uuIsInvar isRevNth_less_length"
apply (cases isRevNth_less_length rule: uuIsInvar)
by(fastforce simp: uu_defs isRevNth_less_length_def
isRevNth_getAllPaperIDs isRev_def2 isRevNth_paperIDs paperIDs_equals less_SucI)+

lemma invar_isRevNth_less_length: "invar isRevNth_less_length"
unfolding invar_cIsInvar_uIsInvar_uuIsInvar
using cIsInvar_isRevNth_less_length uIsInvar_isRevNth_less_length
uuIsInvar_isRevNth_less_length by auto

lemmas isRevNth_less_length1 =
holdsIstate_invar[OF holdsIstate_isRevNth_less_length invar_isRevNth_less_length]

theorem isRevNth_less_length:
assumes "reach s" and "isRevNth s cid uid pid n"
shows "n < length (reviewsPaper (paper s pid))"
using isRevNth_less_length1 assms unfolding isRevNth_less_length_def by blast


(* No two reviewers get assigned the same review: *)
definition isRevNth_equalsU :: "state â bool" where
"isRevNth_equalsU s â¡
 â confID uID uID1 papID n.
    isRevNth s confID uID papID n â§ isRevNth s confID uID1 papID n
    â¶ uID = uID1"

lemma holdsIstate_isRevNth_equalsU: "holdsIstate isRevNth_equalsU"
unfolding IO_Automaton.holdsIstate_def istate_def istate_def isRevNth_equalsU_def by auto

lemma cIsInvar_isRevNth_equalsU: "cIsInvar isRevNth_equalsU"
apply (cases isRevNth_equalsU rule: cIsInvar)
apply(fastforce simp: c_defs isRevNth_equalsU_def)+
proof-
  fix s confID uID p papID uID'
  assume s: "reach s"
  and 0: "isRevNth_equalsU s" "e_createReview s confID uID p papID uID'"
  let ?s' = "createReview s confID uID p papID uID'"
  show "isRevNth_equalsU ?s'"
  unfolding isRevNth_equalsU_def proof clarify
    fix confIDa uIDa uID1 papIDa n
    assume "isRevNth ?s' confIDa uIDa papIDa n" "isRevNth ?s' confIDa uID1 papIDa n"
    thus "uIDa = uID1"
    apply(cases "confIDa = confID â§ papIDa = papID")
    apply(cases "uIDa = uID", cases "uID1 = uID")
    using s 0 isRevNth_less_length[OF s, of papID n] unfolding isRevNth_less_length_def
    by (fastforce simp: c_defs isRevNth_equalsU_def)+
  qed
qed

lemma uIsInvar_isRevNth_equalsU: "uIsInvar isRevNth_equalsU"
apply(cases isRevNth_equalsU rule: uIsInvar)
by (auto simp: u_defs isRevNth_equalsU_def)

lemma uuIsInvar_isRevNth_equalsU: "uuIsInvar isRevNth_equalsU"
apply (cases isRevNth_equalsU rule: uuIsInvar)
by (auto simp: uu_defs isRevNth_equalsU_def)

lemma invar_isRevNth_equalsU: "invar isRevNth_equalsU"
unfolding invar_cIsInvar_uIsInvar_uuIsInvar
using cIsInvar_isRevNth_equalsU uIsInvar_isRevNth_equalsU
uuIsInvar_isRevNth_equalsU by auto

lemmas isRevNth_equalsU1 =
holdsIstate_invar[OF holdsIstate_isRevNth_equalsU invar_isRevNth_equalsU]

theorem isRevNth_equalsU:
assumes a: "reach s" and r: "isRevNth s confID uID papID n" "isRevNth s confID uID1 papID n"
shows "uID = uID1"
using isRevNth_equalsU1[OF a] r unfolding isRevNth_equalsU_def by blast

(* The reviews form a compact interval (with no gaps): *)
definition reviews_compact :: "state â bool" where
"reviews_compact s â¡
 â confID papID n.
    papID ââ paperIDs s confID â§ n < length (reviewsPaper (paper s papID)) â¶
   (â uID. isRevNth s confID uID papID n)"

lemma holdsIstate_reviews_compact: "holdsIstate reviews_compact"
unfolding IO_Automaton.holdsIstate_def istate_def istate_def reviews_compact_def by auto

lemma cIsInvar_reviews_compact: "cIsInvar reviews_compact"
apply(cases reviews_compact rule: cIsInvar)
apply(auto simp: c_defs reviews_compact_def
isRevNth_getAllPaperIDs isRev_def2 isRevNth_paperIDs paperIDs_equals less_SucI)
using paperIDs_confIDs
 apply fastforce
apply metis
apply metis
apply metis
using less_Suc_eq apply auto[1]
apply metis
done

lemma uIsInvar_reviews_compact: "uIsInvar reviews_compact"
apply(cases reviews_compact rule: uIsInvar)
by(fastforce simp: u_defs reviews_compact_def
isRevNth_getAllPaperIDs isRev_def2 isRevNth_paperIDs paperIDs_equals less_SucI)+

lemma uuIsInvar_reviews_compact: "uuIsInvar reviews_compact"
apply (cases reviews_compact rule: uuIsInvar)
by(fastforce simp: uu_defs reviews_compact_def
isRevNth_getAllPaperIDs isRev_def2 isRevNth_paperIDs paperIDs_equals less_SucI)+

lemma invar_reviews_compact: "invar reviews_compact"
unfolding invar_cIsInvar_uIsInvar_uuIsInvar
using cIsInvar_reviews_compact uIsInvar_reviews_compact
uuIsInvar_reviews_compact by auto

lemmas reviews_compact1 =
holdsIstate_invar[OF holdsIstate_reviews_compact invar_reviews_compact]

theorem reviews_compact:
assumes "reach s" and "n < length (reviewsPaper (paper s pid))"
and "pid ââ paperIDs s cid"
shows "â uid. isRevNth s cid uid pid n"
using reviews_compact1 assms unfolding reviews_compact_def by blast


(* The list of roles for each conference-user is nonrepetitive: *)
definition roles_nonrep :: "state â bool" where
"roles_nonrep s â¡
 â confID uID.
    distinct (roles s confID uID)"

lemma holdsIstate_roles_nonrep: "holdsIstate roles_nonrep"
unfolding IO_Automaton.holdsIstate_def istate_def istate_def roles_nonrep_def by auto

lemma cIsInvar_roles_nonrep: "cIsInvar roles_nonrep"
apply(cases roles_nonrep rule: cIsInvar)
by (auto simp: c_defs roles_nonrep_def
isRevNth_getAllPaperIDs isRev_def2 isRevNth_paperIDs paperIDs_equals less_SucI)

lemma uIsInvar_roles_nonrep: "uIsInvar roles_nonrep"
apply(cases roles_nonrep rule: uIsInvar)
by(fastforce simp: u_defs roles_nonrep_def
isRevNth_getAllPaperIDs isRev_def2 isRevNth_paperIDs paperIDs_equals less_SucI)+

lemma uuIsInvar_roles_nonrep: "uuIsInvar roles_nonrep"
apply (cases roles_nonrep rule: uuIsInvar)
by(fastforce simp: uu_defs roles_nonrep_def
isRevNth_getAllPaperIDs isRev_def2 isRevNth_paperIDs paperIDs_equals less_SucI)+

lemma invar_roles_nonrep: "invar roles_nonrep"
unfolding invar_cIsInvar_uIsInvar_uuIsInvar
using cIsInvar_roles_nonrep uIsInvar_roles_nonrep
uuIsInvar_roles_nonrep by auto

lemmas roles_nonrep1 =
holdsIstate_invar[OF holdsIstate_roles_nonrep invar_roles_nonrep]

theorem roles_nonrep:
assumes "reach s"
shows "distinct (roles s confID uID)"
using roles_nonrep1 assms unfolding roles_nonrep_def by blast


subsectionâ¹Properties of the step functionâº

lemma step_outErr_eq: "step s a = (outErr, s') â¹ s'= s"
apply (cases a)
  subgoal for x1 apply (cases x1, simp_all add: c_defs) .
  subgoal for x2 apply (cases x2, simp_all add: u_defs) .
  subgoal for x3 apply (cases x3, simp_all add: uu_defs) .
  by auto

lemma phase_increases:
assumes "step s a = (ou,s')"
shows "phase s cid â¤ phase s' cid"
using assms
apply (cases a)
  subgoal for x1 apply(cases x1) apply(auto simp: c_defs) .
  subgoal for x2 apply(cases x2) apply(auto simp: u_defs) .
  subgoal for x3 apply(cases x3) apply(auto simp: uu_defs) .
  by auto

lemma phase_increases2: "phase s CID â¤ phase (snd (step s a)) CID"
by (metis phase_increases snd_conv surj_pair)

lemma confIDs_mono:
assumes "step s a = (ou,s')" and "cid ââ confIDs s"
shows "cid ââ confIDs s'"
using assms
apply (cases a)
  subgoal for x1 apply(cases x1) apply(auto simp: c_defs) .
  subgoal for x2 apply(cases x2) apply(auto simp: u_defs) .
  subgoal for x3 apply(cases x3) apply(auto simp: uu_defs) .
  by auto

lemma userIDs_mono:
assumes "step s a = (ou,s')" and "uid ââ userIDs s"
shows "uid ââ userIDs s'"
using assms
apply (cases a)
  subgoal for x1 apply(cases x1) apply(auto simp: c_defs) .
  subgoal for x2 apply(cases x2) apply(auto simp: u_defs) .
  subgoal for x3 apply(cases x3) apply(auto simp: uu_defs) .
  by auto

lemma paperIDs_mono:
assumes "step s a = (ou,s')" and "pid ââ paperIDs s cid"
shows "pid ââ paperIDs s' cid"
using assms
apply (cases a)
  subgoal for x1 apply(cases x1) apply(auto simp: c_defs) .
  subgoal for x2 apply(cases x2) apply(auto simp: u_defs) .
  subgoal for x3 apply(cases x3) apply(auto simp: uu_defs) .
  by auto

lemma isPC_persistent:
assumes "isPC s cid uid" and "step s a = (ou, s')"
shows "isPC s' cid uid"
using assms apply (cases a)
  subgoal for x1 apply(cases x1) apply(auto simp: c_defs) .
  subgoal for x2 apply(cases x2) apply(auto simp: u_defs) .
  subgoal for x3 apply(cases x3) apply(auto simp: uu_defs) .
  by auto

lemma isChair_persistent:
assumes "isChair s cid uid" and "step s a = (ou, s')"
shows "isChair s' cid uid"
using assms apply (cases a)
  subgoal for x1 apply(cases x1) apply(auto simp: c_defs) .
  subgoal for x2 apply(cases x2) apply(auto simp: u_defs) .
  subgoal for x3 apply(cases x3) apply(auto simp: uu_defs) .
  by auto


subsection â¹Action-safety propertiesâº

lemma pref_Conflict_disPH:
assumes "reach s" and "pid ââ paperIDs s cid" and "pref s uid pid â  Conflict" and "phase s cid = disPH"
and "step s a = (ou, s')"
shows "pref s' uid pid â  Conflict"
proof-
  have 1: "cid ââ confIDs s" using assms by (metis geq_noPH_confIDs zero_less_Suc)
  thus ?thesis using assms
  apply(cases a)
    subgoal for x1 apply(cases x1, auto simp: c_defs getAllPaperIDs_def)
       apply (metis Suc_inject Zero_not_Suc paperIDs_equals)
      apply (metis Suc_inject Zero_not_Suc paperIDs_equals) .
    subgoal for x2 apply(cases x2, auto simp: u_defs)
      apply (metis Suc_inject Zero_not_Suc paperIDs_equals) .
    subgoal for x3 apply(cases x3, auto simp: uu_defs) .
    by auto
qed

lemma isRevNth_persistent:
assumes "reach s" and "isRevNth s cid uid pid n"
and "step s a = (ou, s')"
shows "isRevNth s' cid uid pid n"
using assms apply (cases a)
  subgoal for x1 apply(cases x1) apply(auto simp: c_defs roles_confIDs) .
  subgoal for x2 apply(cases x2) apply(auto simp: u_defs) .
  subgoal for x3 apply(cases x3) apply(auto simp: uu_defs) .
  by auto

lemma nonempty_decsPaper_persist:
assumes s: "reach s"
and pid: "pid ââ paperIDs s cid"
and "decsPaper (paper s pid) â  []" and "step s a = (ou,s')"
shows "decsPaper (paper s' pid) â  []"
proof-
  have "cid ââ confIDs s" using s pid by (metis paperIDs_confIDs)
  thus ?thesis using assms apply(cases a)
    subgoal for x1 apply(cases x1, auto simp: c_defs getAllPaperIDs_def) .
    subgoal for x2 apply(cases x2, auto simp: u_defs) .
    subgoal for x3 apply(cases x3, auto simp: uu_defs) .
    by auto
qed

lemma nonempty_reviews_persist:
assumes s: "reach s"
and r: "isRevNth s cid uid pid n"
and "(reviewsPaper (paper s pid))!n â  []" and "step s a = (ou,s')"
shows "(reviewsPaper (paper s' pid))!n â  []"
proof-
  have pid: "pid ââ paperIDs s cid" using s r by (metis isRevNth_paperIDs)
  have cid: "cid ââ confIDs s" using s pid by (metis paperIDs_confIDs)
  have n: "n < length (reviewsPaper (paper s pid))" using s r by (metis isRevNth_less_length)
  show ?thesis using assms pid cid n apply(cases a)
    subgoal for x1 apply(cases x1, auto simp: c_defs getAllPaperIDs_def) .
    subgoal for x2 apply(cases x2, auto simp: u_defs)
      apply (metis not_Cons_self2 nth_list_update_eq nth_list_update_neq) .
    subgoal for x3 apply(cases x3, auto simp: uu_defs)
      apply (metis list.distinct(1) nth_list_update_eq nth_list_update_neq) .
    by auto
qed

lemma revPH_pref_persists:
assumes "reach s"
"pid ââ paperIDs s cid" and "phase s cid â¥ revPH"
and "step s a = (ou,s')"
shows "pref s' uid pid = pref s uid pid"
using assms apply(cases a)
  subgoal for x1 apply(cases x1) apply(auto simp: c_defs paperIDs_getAllPaperIDs)
    using paperIDs_equals apply fastforce
    using paperIDs_equals apply fastforce .
  subgoal for x2 apply(cases x2) apply(auto simp: u_defs)
    using paperIDs_equals apply fastforce .
  subgoal for x3 apply(cases x3) apply(fastforce simp: uu_defs)+ .
  by auto


subsection â¹Miscellaneousâº

(* Simps bringing the "paper" field all the way to the left---useful for situations
   where the states are equal everywhere but on the paper field. *)
lemma updates_commute_paper:
 "â uu. s â¦confIDs := uu, paper := ppâ¦ = s â¦paper := pp, confIDs := uuâ¦"
 "â uu. s â¦conf := uu, paper := ppâ¦ = s â¦paper := pp, conf := uuâ¦"

 "â uu. s â¦userIDs := uu, paper := ppâ¦ = s â¦paper := pp, userIDs := uuâ¦"
 "â uu. s â¦pass := uu, paper := ppâ¦ = s â¦paper := pp, pass := uuâ¦"
 "â uu. s â¦user := uu, paper := ppâ¦ = s â¦paper := pp, user := uuâ¦"
 "â uu. s â¦roles := uu, paper := ppâ¦ = s â¦paper := pp, roles := uuâ¦"

 "â uu. s â¦paperIDs := uu, paper := ppâ¦ = s â¦paper := pp, paperIDs := uuâ¦"

 "â uu. s â¦pref := uu, paper := ppâ¦ = s â¦paper := pp, pref := uuâ¦"
 "â uu. s â¦voronkov := uu, paper := ppâ¦ = s â¦paper := pp, voronkov := uuâ¦"
 "â uu. s â¦news := uu, paper := ppâ¦ = s â¦paper := pp, news := uuâ¦"
 "â uu. s â¦phase := uu, paper := ppâ¦ = s â¦paper := pp, phase := uuâ¦"
by (auto intro: state.equality)


(* The implication between the implicit- and explicit conference ID selectors *)

lemma isAUT_imp_isAut:
assumes "reach s" and "pid ââ paperIDs s cid" and "isAUT s uid pid"
shows "isAut s cid uid pid"
by (metis assms isAUT_def isAut_paperIDs paperIDs_equals)

lemma isREVNth_imp_isRevNth:
assumes "reach s" and "pid ââ paperIDs s cid" and "isREVNth s uid pid n"
shows "isRevNth s cid uid pid n"
by (metis assms isREVNth_def isRevNth_paperIDs paperIDs_equals)


(* BEGIN phase properties *)

lemma phase_increases_validTrans:
assumes "validTrans (Trans s a ou s')"
shows "phase s cid â¤ phase s' cid"
using assms apply(cases a)
  subgoal for x1 apply(cases x1, auto simp: c_defs split: if_splits) .
  subgoal for x2 apply(cases x2, auto simp: u_defs split: if_splits paper.splits) .
  subgoal for x3 apply(cases x3, auto simp: uu_defs split: if_splits paper.splits) .
  by auto

lemma phase_increases_validTrans2:
assumes "validTrans tr"
shows "phase (srcOf tr) cid â¤ phase (tgtOf tr) cid"
using assms phase_increases_validTrans by (cases tr) auto

lemma phase_increases_trace:
assumes vtr: "valid tr" and ij: "i â¤ j" and j: "j < length tr"
shows "phase (srcOf (tr!i)) cid â¤ phase (srcOf (tr!j)) cid"
proof(cases "i < j")
case False thus ?thesis using ij by auto
next
case True thus ?thesis
using j proof(induction j)
  case (Suc jj)
  show ?case
  proof(cases "jj = i")
    case True
    obtain tr1 tr2 where tr: "tr = tr1 @ (tr!i) # (tr!(Suc jj)) # tr2"
    unfolding True by (metis Cons_nth_drop_Suc Suc.prems(2) Suc_lessD True id_take_nth_drop)
    hence "validTrans (tr!i) â§ tgtOf (tr!i) = srcOf (tr!(Suc jj))"
    unfolding True by (metis Suc Suc_lessD True valid_validTrans_nth valid_validTrans_nth_srcOf_tgtOf vtr)
    thus ?thesis using phase_increases_validTrans Suc by (cases "tr!i") auto
  next
    case False hence 1: "i < jj â§ jj < length tr" using Suc by auto
    hence "phase (srcOf (tr!i)) cid â¤ phase (srcOf (tr!jj)) cid" using Suc by auto
    also have "phase (srcOf (tr!jj)) cid â¤ phase (tgtOf (tr!jj)) cid"
    using phase_increases_validTrans2 by (metis 1 valid_validTrans_nth vtr)
    also have "... = phase (srcOf (tr!(Suc jj))) cid"
    by (metis Suc valid_validTrans_nth_srcOf_tgtOf vtr)
    finally show ?thesis .
  qed
qed auto
qed

lemma phase_increases_trace_srcOf_tgtOf:
assumes vtr: "valid tr" and ij: "i â¤ j" and j: "j < length tr"
shows "phase (srcOf (tr!i)) cid â¤ phase (tgtOf (tr!j)) cid"
  using phase_increases_trace[OF assms]
  using j le_trans phase_increases_validTrans2 valid_validTrans_nth vtr by blast

lemma phase_increases_trace_srcOf_hd:
assumes v: "valid tr" and l: "length tr > 1" and "i < length tr"
shows "phase (srcOf (hd tr)) cid â¤ phase (srcOf (tr!i)) cid"
using phase_increases_trace assms
by (metis gr_implies_not0 hd_Cons_tl leI length_0_conv nth_Cons_0)

lemma phase_increases_trace_srcOf_last:
assumes v: "valid tr" and l: "length tr > 1" and i: "i < length tr"
shows "phase (srcOf (tr!i)) cid â¤ phase (srcOf (last tr)) cid"
proof-
  have 1: "last tr = tr!(length tr - 1)"
  by (metis i last_conv_nth list.size(3) not_less0)
  show ?thesis unfolding 1 using assms
  by (metis Suc_diff_1 Suc_leI Suc_le_mono gr_implies_not0 length_0_conv
          length_greater_0_conv lessI phase_increases_trace)
qed

lemma phase_increases_trace_srcOf_tgtOf_last:
assumes v: "valid tr" and l: "length tr > 1" and i: "i < length tr"
shows "phase (srcOf (tr!i)) cid â¤ phase (tgtOf (last tr)) cid"
proof-
  have 1: "last tr = tr!(length tr - 1)"
  by (metis i last_conv_nth list.size(3) not_less0)
  have "phase (srcOf (tr!i)) cid â¤ phase (srcOf (last tr)) cid" using
  phase_increases_trace_srcOf_last[OF assms] .
  also have "... â¤ phase (tgtOf (last tr)) cid" unfolding 1
  by (metis Suc_le_D diff_Suc_1 l lessI less_eq_Suc_le phase_increases_validTrans2 v valid_validTrans_nth)
  finally show ?thesis by (simp add: le_funD)
qed

lemma valid_tgtPf_last_srcOf:
assumes "valid tr" and "s ââ map tgtOf tr"
shows "s = tgtOf (last tr) â¨ s ââ map srcOf tr"
using assms by induction auto

lemma phase_constant:
assumes v: "valid tr" and l: "length tr > 0" and
ph: "phase (srcOf (hd tr)) cid = phase (tgtOf (last tr)) cid"
shows "set (map (Î» trn. phase (srcOf trn) cid) tr) â {phase (srcOf (hd tr)) cid} â§
       set (map (Î» trn. phase (tgtOf trn) cid) tr) â {phase (srcOf (hd tr)) cid}"
proof(cases "length tr > 1")
  case False
  then obtain trn where tr: "tr = [trn]" using l by (cases tr) auto
  show ?thesis using assms unfolding tr by auto
next
  case True note l = True
  show ?thesis proof safe
    {fix ph assume "ph ââ map (Î» trn. phase (srcOf trn) cid) tr"
     then obtain i where i: "i < length tr" and phe: "ph = phase (srcOf(tr!i)) cid"
     by (smt comp_apply in_set_conv_nth length_map nth_map)
     have "phase (srcOf (hd tr)) cid â¤ ph"
     unfolding phe using v l i phase_increases_trace_srcOf_hd by blast
     moreover have "ph â¤ phase (tgtOf (last tr)) cid"
     unfolding phe using v l i phase_increases_trace_srcOf_tgtOf_last by auto
     ultimately show "ph = phase (srcOf (hd tr)) cid" using ph by simp
    } note 0 = this
    fix ph assume "ph ââ map (Î» trn. phase (tgtOf trn) cid) tr"
    then obtain s where "s ââ map tgtOf tr" and phs: "ph = phase s cid" by auto
    hence "s = tgtOf (last tr) â¨ s ââ map srcOf tr" using valid_tgtPf_last_srcOf[OF v] by auto
    thus "ph = phase (srcOf (hd tr)) cid" using 0[of ph] ph unfolding phs by auto
  qed
qed

lemma phase_cases:
assumes "step s a = (ou, s')"
obtains (noPH) "Â¬ cid ââ confIDs s â¨ phase s cid = noPH"
(* the conf. does not exist yet or the voronkov has not yet approved it *)
      | (Id) "phase s' cid = phase s cid"
      | (Upd) uid p ph where "phase s' cid = ph" "a = Uact (uPhase cid uid p ph)" "e_updatePhase s cid uid p ph"
using assms proof (cases a)
  case (Cact ca)
  then show thesis using assms
    by (cases ca) (auto simp: c_defs split: if_splits intro: that)
next
  case (Uact ua)
  then show thesis using assms
    apply (cases ua)
    subgoal by (auto simp: u_defs split: if_splits paper.splits intro: that)
    subgoal for x21 apply(cases "x21 = cid")
      by (auto simp: u_defs split: if_splits paper.splits intro: that)
    subgoal for x31 apply(cases "cid = x31")
      by (auto simp: u_defs split: if_splits paper.splits intro: that)
    by (auto simp: u_defs split: if_splits paper.splits intro: that)
next
  case (UUact uua)
  then show thesis using assms by (cases uua) (auto simp: uu_defs split: if_splits paper.splits intro: that)
qed auto

lemma phase_mono: "reachFrom s s' â¹ phase s cid â¤ phase s' cid"
proof (induction rule: reachFrom_step_induct)
  case (Step s' a ou s'')
    then show ?case
    proof (cases a)
      case (Cact cAct) with Step show ?thesis by (cases cAct) (auto simp add: c_defs split: if_splits) next
      case (Uact uAct) with Step show ?thesis by (cases uAct) (auto simp add: u_defs split: if_splits paper.split) next
      case (UUact uAct) with Step show ?thesis by (cases uAct) (auto simp add: uu_defs split: if_splits paper.split)
    qed (auto)
qed (auto)

lemma validTrans_rAct_lAct_srcOf_tgtOf:
assumes "validTrans trn"
and "actOf trn = Ract rAct â¨ actOf trn = Lact lAct"
shows "tgtOf trn = srcOf trn"
using assms by (cases trn) auto

lemma valid_rAct_lAct_srcOf_tgtOf:
assumes "valid tr"
and "â a. a ââ map actOf tr â¹ (â rAct. a = Ract rAct) â¨ (â lAct. a = Lact lAct)"
shows "srcOf ` (set tr) â {srcOf (hd tr)}"
using assms by (induction) (simp_all, metis validTrans_rAct_lAct_srcOf_tgtOf)

lemma validFrom_rAct_lAct_srcOf_tgtOf:
assumes "validFrom s tr"
and "â a. a ââ map actOf tr â¹ (â rAct. a = Ract rAct) â¨ (â lAct. a = Lact lAct)"
shows "srcOf ` (set tr) â {s}"
using assms valid_rAct_lAct_srcOf_tgtOf unfolding validFrom_def by auto

lemma tgtOf_last_traceOf_Ract_Lact[simp]:
assumes "al â  []" "set al â range Ract âª range Lact"
shows "tgtOf (last (traceOf s al)) = s"
using assms by (induction al arbitrary: s) auto

(* END phase properties *)

lemma paperIDs_cases:
assumes "step s a = (ou, s')"
obtains (Id) "paperIDs s' cid = paperIDs s cid"
      | (Create) cid uid p pid tit ab  where
           "paperIDs s' cid = pid # paperIDs s cid" "a = Cact (cPaper cid uid p pid tit ab)"
           "e_createPaper s cid uid p pid tit ab"
using assms proof (cases a)
  case (Cact ca)
  then show thesis using assms
    by (cases ca) (auto simp: c_defs split: if_splits intro: that)
next
  case (Uact ua)
  then show thesis using assms
    by (cases ua) (auto simp: u_defs split: if_splits paper.splits intro: that)
next
  case (UUact ua)
  then show thesis using assms
    by (cases ua) (auto simp: uu_defs split: if_splits paper.splits intro: that)
qed auto

lemma paperIDs_decPH_const:
assumes s: "step s a = (ou, s')" and "phase s cid > subPH"
shows "paperIDs s' cid = paperIDs s cid"
  using assms
  apply (elim paperIDs_cases[where cid = cid])
  subgoal .
  subgoal for cida
    apply(cases "cida = cid", auto)
    using s by (auto simp: c_defs) .

end

dy>

Theory Paper_Aut_PC

theory Paper_Aut_PC
imports "../Observation_Setup" Paper_Value_Setup "Bounded_Deducibility_Security.Compositional_Reasoning"
begin

subsection â¹Confidentiality protection from users who are not the
paper's authors or PC membersâº

text â¹We verify the following property:

\ \\
A group of users UIDs
learns nothing about the various uploads of a paper PID
(save for the non-existence of any upload)
unless/until one of the following occurs:
\begin{itemize}
\item a user in UIDs becomes the paper's author or
\item a user in UIDs becomes a PC member in the paper's conference
and the conference moves to the bidding phase.
\end{itemize}
âº

fun T :: "(state,act,out) trans â bool" where
"T (Trans _ _ ou s') =
 (â uid â UIDs.
    isAUT s' uid PID â¨
    (â cid. PID ââ paperIDs s' cid â§ isPC s' cid uid â§ phase s' cid â¥ bidPH)
 )"

declare T.simps [simp del]

definition B :: "value list â value list â bool" where
"B vl vl1 â¡ vl â  []"

interpretation BD_Security_IO where
istate = istate and step = step and
Ï = Ï and f = f and Î³ = Î³ and g = g and T = T and B = B
done

lemma reachNT_non_isAut_isPC_isChair:
assumes "reachNT s" and "uid â UIDs"
shows
"Â¬ isAut s cid uid PID â§
 (isPC s cid uid â¶ Â¬ PID ââ paperIDs s cid â¨ phase s cid â¤ subPH) â§
 (isChair s cid uid â¶ Â¬ PID ââ paperIDs s cid â¨ phase s cid â¤ subPH)"
  using assms
  apply (cases rule: reachNT_state_cases)
   apply (auto simp: istate_def)[]
  apply clarsimp
    (* safety property used: isChair_isPC *)
  by (simp add: T.simps assms(1) isAUT_def isChair_isPC not_less_eq_eq reachNT_reach)


lemma P_Ï_Î³:
assumes 1: "reachNT s" and 2: "step s a = (ou,s')" "Ï (Trans s a ou s')"
shows "Â¬ Î³ (Trans s a ou s')"
using reachNT_non_isAut_isPC_isChair[OF 1] 2 unfolding T.simps Ï_def2
by (auto simp add: u_defs)

(* Note: the following alternative formulation is not always guaranteed to hold,
due to the trigger T speaking about s', not s:
lemma P_Ï_Î³:
assumes 1: "Â¬ T (Trans s a ou s')" and 2: "step s a = (ou,s')" "Ï (Trans s a ou s')"
shows "Â¬ Î³ (Trans s a ou s')"
using 1 2 unfolding T.simps Ï_def2
by (auto simp add: u_defs)
*)

text â¹majorâº lemma eqButPID_step_out:
assumes s's1': "eqButPID s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and sT: "reachNT s" and s1: "reach s1"
and PID: "PID ââ paperIDs s cid"
and UIDs: "userOfA a â UIDs"
shows "ou = ou1"
proof-
  note Inv = reachNT_non_isAut_isPC_isChair[OF sT UIDs]
  note eqs = eqButPID_imp[OF s's1']
  note eqs' = eqButPID_imp1[OF s's1']
  note s = reachNT_reach[OF sT]

  note simps[simp] = c_defs u_defs uu_defs r_defs l_defs Paper_dest_conv eqButPID_def eeqButPID_def eqButC
  note * = step step1 eqs eqs' s s1 PID UIDs paperIDs_equals[OF s] Inv

  show ?thesis
  proof (cases a)
    case (Cact x1)
    then show ?thesis using * by (cases x1; auto)
  next
    case (Uact x2)
    then show ?thesis using * by (cases x2; auto)
  next
    case (UUact x3)
    then show ?thesis using * by (cases x3; auto)
  next
    case (Ract x4)
    with * show ?thesis
    proof (cases x4)
      case (rPaperC x61 x62 x63 x64)
      then show ?thesis using * Ract by (clarsimp; metis not_less_eq_eq)
    next
      case (rMyReview x81 x82 x83 x84)
      then show ?thesis using * Ract by (auto simp: getNthReview_def)
    next
      case (rReviews x91 x92 x93 x94)
      then show ?thesis using * Ract by (clarsimp; metis Suc_leD eqButPID_imp2 not_less_eq_eq s's1')
    qed auto
  next
    case (Lact x5)
    then show ?thesis using * by (cases x5; auto)
  qed
qed

definition Î1 :: "state â value list â state â value list â bool" where
"Î1 s vl s1 vl1 â¡ Â¬ (âcid. PID ââ paperIDs s cid) â§ s = s1 â§ B vl vl1"

definition Î2 :: "state â value list â state â value list â bool" where
"Î2 s vl s1 vl1 â¡
 âcid. PID ââ paperIDs s cid â§ phase s cid = subPH â§ eqButPID s s1"

definition Î3 :: "state â value list â state â value list â bool" where
"Î3 s vl s1 vl1 â¡
 âcid. PID ââ paperIDs s cid â§ eqButPID s s1 â§ phase s cid > subPH â§ vl=[] â§ vl1=[]"

definition Îe :: "state â value list â state â value list â bool" where
"Îe s vl s1 vl1 â¡
 âcid. PID ââ paperIDs s cid â§ phase s cid > subPH â§ vl â  []"

lemma istate_Î1:
assumes B: "B vl vl1"
shows "Î1 istate vl istate vl1"
using B unfolding Î1_def B_def istate_def by auto

lemma unwind_cont_Î1: "unwind_cont Î1 {Î1,Î2,Îe}"
proof(rule, goal_cases)
  case (1 s vl s1 vl1)
  (*fix s s1 :: state and vl vl1 :: "value list"*)
  assume rsT: "reachNT s" and rs1: "reach s1" and "Î1 s vl s1 vl1"
  hence rs: "reach s" and ss1: "s1 = s" and vl: "vl â  []"
    and pid: "âcid. PID â set (paperIDs s cid)"
  using reachNT_reach unfolding Î1_def B_def by auto
  show ?case (is "?iact â¨ (_ â§ ?react)")
  proof-
    have ?react proof (rule, goal_cases)
      case (1 a ou s' vl')
      let ?trn = "Trans s a ou s'"  let ?trn1 = "Trans s1 a ou s'"
      assume step: "step s a = (ou, s')"
        and T: "Â¬ T ?trn" and c: "consume ?trn vl vl'"
      have Ï: "Â¬ Ï ?trn"
        apply(cases a)
        subgoal by simp
        subgoal for x2 apply(cases x2) using step pid by(auto simp: u_defs)
        by simp_all
      hence vl': "vl' = vl" using c unfolding consume_def by auto
      show ?case (is "?match â¨ ?ignore")
      proof-
        have ?match proof
          show "validTrans ?trn1" unfolding ss1 using step by simp
        next
          show "consume ?trn1 vl1 vl1" unfolding consume_def ss1 using Ï by auto
        next
          show "Î³ ?trn = Î³ ?trn1" unfolding ss1 by simp
        next
          assume "Î³ ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
        next
          show "disjAll {Î1, Î2, Îe} s' vl' s' vl1"
          proof (cases "âcid. PID ââ paperIDs s' cid")
            case False hence "Î1 s' vl' s' vl1"
              by (simp add: Î1_def B_def vl vl')
            thus ?thesis by simp
          next
            case True
            hence "Î2 s' vl' s' vl1"
              using step pid
              apply (simp add: Î2_def vl' vl)
              apply (erule exE)
              subgoal for cid apply (rule exI[of _ cid])
                apply (cases a)
                  subgoal for x1 apply (cases x1, auto simp: c_defs) [] .
                  subgoal for x2 apply (cases x2, auto simp: u_defs) [] .
                  subgoal for x3 apply (cases x3, auto simp: uu_defs) [] .
                  by simp_all
              done
            thus ?thesis by simp
          qed
        qed
        thus ?thesis by simp
      qed
    qed
    thus ?thesis using vl by simp
  qed
qed

lemma unwind_cont_Î2: "unwind_cont Î2 {Î2,Î3,Îe}"
proof(rule,goal_cases)
  case (1 s vl s1 vl1)
  assume rsT: "reachNT s" and rs1: "reach s1" and "Î2 s vl s1 vl1"
  then obtain cid where rs: "reach s"
    and pid: "PID ââ paperIDs s cid" and ss1: "eqButPID s s1"
    and ph: "phase s cid = subPH"
    using reachNT_reach unfolding Î2_def by auto

  have cid: "cid ââ confIDs s"
    by (metis paperIDs_confIDs pid rs)

  from pid ph cid have
    pid1: "PID ââ paperIDs s1 cid"
    and ph1: "phase s1 cid = subPH"
    and cid1: "cid ââ confIDs s1"
    by (auto simp add: eqButPID_imp[OF ss1])


  show ?case (is "?iact â¨ (_ â§ ?react)")
  proof (cases vl1)
    case (Cons v vl1') note this[simp]
    obtain uid1 where aut1: "isAut s1 cid uid1 PID"
      thm paperID_ex_userID
      using paperID_ex_userID[OF rs1 pid1] by auto
    have uid1: "uid1 ââ userIDs s1"
      by (metis roles_userIDs rs1 aut1)

    from aut1 have "isAut s cid uid1 PID"
      using ss1 aut1 by (simp add: eqButPID_imp[OF ss1])
    with reachNT_non_isAut_isPC_isChair[OF rsT] uid1 have uid1_ne: "uid1âUIDs"
      by auto

    let ?a1 = "(Uact (uPaperC cid uid1 (pass s1 uid1) PID v))"
    obtain s1' where step: "step s1 ?a1 = (outOK,s1')" and s1's1: "eqButPID s1' s1"
      by (cases "paper s1 PID")
         (auto simp add: u_defs cid1 uid1 pid1 ph1 aut1 eqButPID_def eeqButPID_def)

    have "?iact"
    proof
      show "step s1 ?a1 = (outOK,s1')" using step .
      show "Ï (Trans s1 ?a1 outOK s1')" by simp
      show "consume (Trans s1 ?a1 outOK s1') vl1 vl1'" by (simp add: consume_def)
      show "Â¬Î³ (Trans s1 ?a1 outOK s1')" by (simp add: uid1_ne)
      have "Î2 s vl s1' vl1'" unfolding Î2_def
        apply (rule exI[where x=cid])
        using ph pid
        apply clarsimp
        by (metis s1's1 eqButPID_sym eqButPID_trans ss1)
      thus "disjAll {Î2, Î3, Îe} s vl s1' vl1'" by simp
    qed
    thus ?thesis by simp
  next
    case Nil note this[simp]
    have "?react"
    proof (rule, goal_cases)
      case (1 a ou s' vl')
      assume STEP: "step s a = (ou, s')" and "Â¬ T (Trans s a ou s')"
        and CONSUME: "consume (Trans s a ou s') vl vl'"

      have ph': "phase s' cid â¥ subPH"
        by (smt STEP ph phase_increases)

      have pid': "PID ââ paperIDs s' cid" using pid STEP
        by (metis paperIDs_mono)

      {
        fix s1 vl1
        assume "phase s' cid â  subPH" "vl'â []"
        hence "Îe s' vl' s1 vl1"
          unfolding Îe_def
          apply -
          apply(rule exI[of _ cid])
          using STEP CONSUME ph
          apply (cases a)
          subgoal for x1 apply (cases x1) apply(auto simp: c_defs) .
          subgoal for x2 apply (cases x2) apply(auto simp: u_defs consume_def pid) .
          subgoal for x3 apply (cases x3) apply(auto simp: uu_defs) .
          by simp_all
      } note Îe=this

      obtain s1' ou' where
        STEP': "step s1 a = (ou',s1')" and s's1': "eqButPID s' s1'"
        using eqButPID_step[OF ss1 STEP]
        by fastforce

      from eqButPID_step_Ï[OF ss1 STEP STEP']
      have Ï_eq: "Ï (Trans s1 a ou' s1') = Ï (Trans s a ou s')" by simp

      show ?case (is "?match â¨ ?ignore")
      proof (cases "Ï (Trans s a ou s')")
        case True note Ï=this

        then obtain cid' uid p where
          a[simp]: "a=Uact (uPaperC cid' uid p PID (hd vl))" "ou=outOK"
          using CONSUME
          by (cases "(Trans s a ou s')" rule: f.cases) (auto simp add: consume_def)

        from STEP pid have [simp]: "cid'=cid"
          by (simp add: u_defs paperIDs_equals[OF rs])

        from Ï_step_eqButPID[OF Ï STEP] have ss': "eqButPID s s'" .

        have nÎ³: "Â¬Î³ (Trans s a ou s')"
          using P_Ï_Î³[OF rsT STEP] by simp

        have ph': "phase s' cid = subPH"
          using STEP by (auto simp add: u_defs)

        have ?ignore
        proof
          show "Â¬ Î³ (Trans s a ou s')" by (rule nÎ³)
          have "Î2 s' vl' s1 vl1"
            unfolding Î2_def
            using ph' pid' eqButPID_trans[OF eqButPID_sym[OF ss'] ss1]
            by auto
          thus "disjAll {Î2, Î3, Îe} s' vl' s1 vl1" by simp
        qed
        thus ?thesis by simp
      next
        case False note Ï=this
        with CONSUME have [simp]: "vl'=vl" by (simp add: consume_def)

        have ?match proof
          show "validTrans (Trans s1 a ou' s1')" using STEP' by simp
          show "consume (Trans s1 a ou' s1') vl1 vl1" using Ï
            by (simp add: consume_def Ï_eq)
          show "Î³ (Trans s a ou s') = Î³ (Trans s1 a ou' s1')" by simp
          show "Î³ (Trans s a ou s') â¹ g (Trans s a ou s') = g (Trans s1 a ou' s1')"
            using eqButPID_step_out[OF ss1 STEP STEP' rsT rs1 pid]
            by simp
          show "disjAll {Î2, Î3, Îe} s' vl' s1' vl1"
          proof (cases "phase s' cid = subPH")
            case True
            hence "Î2 s' vl' s1' vl1"
              unfolding Î2_def
              using eqButPID_step[OF ss1 STEP STEP']
              using ph' pid' by auto
            thus ?thesis by simp
          next
            case False with ph' have ph': "subPH < phase s' cid" by simp
            show ?thesis proof (cases "vl'=[]")
              case False
              hence "Îe s' vl' s1' vl1" using Îe ph' by simp
              thus ?thesis by simp
            next
              case True
              hence "Î3 s' vl' s1' vl1"
                unfolding Î3_def
                apply(intro exI[of _ cid])
                using ph' pid' eqButPID_step[OF ss1 STEP STEP']
                by simp
              thus ?thesis by simp
            qed
          qed
        qed
        thus ?thesis by simp
      qed
    qed
    thus ?thesis by simp
  qed
qed

lemma unwind_cont_Î3: "unwind_cont Î3 {Î3,Îe}"
proof (rule, goal_cases)
  case (1 s vl s1 vl1)
  assume rsT: "reachNT s" and rs1: "reach s1" and Î: "Î3 s vl s1 vl1"
  thm Î3_def
  then obtain cid where ss1: "eqButPID s s1" and [simp]: "vl=[]" "vl1=[]"
    and pid: "PID ââ paperIDs s cid" and ph: "subPH < phase s cid"
    unfolding Î3_def by auto

  from rsT have rs: "reach s"
    by (metis reachNT_reach)

  from pid ph have
    pid1: "PID ââ paperIDs s1 cid"
    and ph1: "subPH < phase s1 cid"
    using ss1
    by (auto simp add: eqButPID_imp)


  thus ?case (is "_ â¨ (_ â§ ?react)")
  proof -
    have "?react"
    proof (rule, goal_cases)
      case (1 a ou s' vl')
      assume STEP: "step s a = (ou, s')" and NT: "Â¬ T (Trans s a ou s')" (is "Â¬T ?trn")
        and CONSUME: "consume (Trans s a ou s') vl vl'"

      show ?case (is "?match â¨ _")
      proof -

        have ph': "subPH < phase s' cid"
         using STEP ph phase_increases by (meson le_trans not_less)

        have [simp]: "vl'=[]" using CONSUME by (auto simp add: consume_def)

        obtain ou1 and s1' where STEP1: "step s1 a = (ou1,s1')"
          by (metis prod.exhaust)
        let ?trn1 = "Trans s1 a ou1 s1'"
        have s's1': "eqButPID s' s1'" using eqButPID_step[OF ss1 STEP STEP1] .

        from s's1' ph' have ph1': "subPH < phase s1' cid"
          by (simp add: eqButPID_imp)

        have Ï: "Â¬ Ï ?trn1"
          using STEP1 ph1' unfolding Ï_def2 by (auto simp: u_defs paperIDs_equals[OF rs1 pid1])

        have ?match proof
          show "validTrans ?trn1" using STEP1 by simp
        next
          show "consume ?trn1 vl1 vl1" unfolding consume_def using Ï by auto
        next
          show "Î³ ?trn = Î³ ?trn1" unfolding ss1 by simp
        next
          assume "Î³ ?trn" thus "g ?trn = g ?trn1"
          using eqButPID_step_out[OF ss1 STEP STEP1 rsT rs1 pid] by simp
        next
          have "Î3 s' vl' s1' vl1" using ph' s's1' paperIDs_mono[OF STEP pid]
            unfolding Î3_def by auto
          thus "disjAll {Î3, Îe} s' vl' s1' vl1" by simp
        qed
        thus ?thesis by simp
      qed
    qed
    thus ?case by simp
  qed
qed


definition K1exit where
"K1exit s â¡ âcid. phase s cid > subPH â§ PID ââ paperIDs s cid"

lemma invarNT_K1exit: "invarNT K1exit"
  unfolding invarNT_def apply (safe dest!: reachNT_reach)
  subgoal for _ a apply(cases a)
    subgoal for x1 apply (cases x1, auto simp: c_defs K1exit_def) .
    subgoal for x2 apply (cases x2)
      apply(auto simp: u_defs K1exit_def paperIDs_equals)
      apply (metis less_nat_zero_code)
      apply (metis Suc_lessD) .
    subgoal for x3 apply (cases x3, auto simp: uu_defs K1exit_def) .
    by simp_all
  done

lemma noVal_K1exit: "noVal K1exit v"
  apply(rule noÏ_noVal)
  unfolding noÏ_def apply safe
  subgoal for _ a apply(cases a)
    subgoal by simp
    subgoal for x2
      apply(cases x2, auto simp add: u_defs K1exit_def) []
      apply (metis reachNT_reach less_not_refl paperIDs_equals) .
    by simp_all
  done

lemma unwind_exit_Îe: "unwind_exit Îe"
proof
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and Îe: "Îe s vl s1 vl1"
  hence vl: "vl â  []" using reachNT_reach unfolding Îe_def by auto
  hence "K1exit s" using Îe unfolding K1exit_def Îe_def by auto
  thus "vl â  [] â§ exit s (hd vl)" apply(simp add: vl)
  by (metis rsT exitI2 invarNT_K1exit noVal_K1exit)
qed

theorem secure: secure
  apply(rule unwind_decomp3_secure[of Î1 Î2 Îe Î3])
  using
    istate_Î1
    unwind_cont_Î1 unwind_cont_Î2 unwind_cont_Î3
    unwind_exit_Îe
  by auto

end

Theory Paper_Aut

theory Paper_Aut
imports "../Observation_Setup" Paper_Value_Setup "Bounded_Deducibility_Security.Compositional_Reasoning"
begin

subsection â¹Confidentiality protection from non-authorsâº

text â¹We verify the following property:

\ \\
A group of users UIDs
learns nothing about the various uploads of a paper PID
except for the last (most recent) upload
unless/until a user in UIDs becomes an author of the paper.

\ \\
âº

fun T :: "(state,act,out) trans â bool" where
"T (Trans _ _ ou s') = (â uid â UIDs. isAUT s' uid PID)"

declare T.simps [simp del]

definition B :: "value list â value list â bool" where
"B vl vl1 â¡ vl â  [] â§ vl1 â  [] â§ last vl = last vl1"

interpretation BD_Security_IO where
istate = istate and step = step and
Ï = Ï and f = f and Î³ = Î³ and g = g and T = T and B = B
done

lemma reachNT_non_isAut:
assumes "reachNT s" and "uid â UIDs"
shows "Â¬ isAut s cid uid PID"
  using assms
  apply induct
   apply (auto simp: istate_def)[]
  subgoal for trn apply(cases trn, auto simp: T.simps reachNT_reach isChair_isPC isAUT_def) .
  done


lemma T_Ï_Î³:
assumes 1: "reachNT s" and 2: "step s a = (ou,s')" "Ï (Trans s a ou s')"
shows "Â¬ Î³ (Trans s a ou s')"
using reachNT_non_isAut[OF 1] 2 unfolding T.simps Ï_def2
by (auto simp add: u_defs)

(* major *) lemma eqButPID_step_out:
assumes ss1: "eqButPID s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and sT: "reachNT s" and s1: "reach s1"
and PID: "PID ââ paperIDs s cid"
and ph: "phase s cid = subPH"
and UIDs: "userOfA a â UIDs"
shows "ou = ou1"
proof-
  note Inv = reachNT_non_isAut[OF sT UIDs]
  note eqs = eqButPID_imp[OF ss1]
  note eqs' = eqButPID_imp1[OF ss1]
  note s = reachNT_reach[OF sT]
  have PID': "PID ââ paperIDs s1 cid" and ph': "phase s cid = subPH"
  using PID ph ss1 unfolding eqButPID_def by auto

  note simps[simp] = c_defs u_defs uu_defs r_defs l_defs Paper_dest_conv eqButPID_def eeqButPID_def eqButC
  note * = step step1 eqs eqs' s s1 PID ph PID' ph' UIDs paperIDs_equals[OF s] Inv

  show ?thesis
  proof (cases a)
    case (Cact x1)
    then show ?thesis using * by (cases x1; auto)
  next
    case (Uact x2)
    then show ?thesis using * by (cases x2; auto)
  next
    case (UUact x3)
    then show ?thesis using * by (cases x3; auto)
  next
    case (Ract x4)
    with * show ?thesis
    proof (cases x4)
      case (rPaperC x61 x62 x63 x64)
      then show ?thesis using * Ract by (clarsimp; metis Suc_n_not_le_n)
    next
      case (rMyReview x81 x82 x83 x84)
      then show ?thesis using * Ract by (auto simp: getNthReview_def)
    next
      case (rReviews x91 x92 x93 x94)
      then show ?thesis using * Ract by (clarsimp; metis Suc_leD eqButPID_imp2 not_less_eq_eq ss1)
    qed auto
  next
    case (Lact x5)
    then show ?thesis using * by (cases x5; auto)
  qed
qed

text â¹majorâº lemma eqButPID_step_eq:
assumes ss1: "eqButPID s s1"
and [simp]: "a=Uact (uPaperC cid uid p PID ct)" "ou=outOK"
and step: "step s a = (ou, s')" and step1: "step s1 a = (ou', s1')"
shows "s' = s1'"
  using ss1 step step1
  apply (simp add: u_defs eqButPID_paper )
  subgoal by (cases s; cases s1; auto simp add: eqButPID_def eeqButPID_def)
  subgoal by (use ss1 step step1 in â¹auto simp add: eqButPID_def eeqButPID_defâº)
  done

definition Î1 :: "state â value list â state â value list â bool" where
"Î1 s vl s1 vl1 â¡
 Â¬ (â cid. PID ââ paperIDs s cid) â§ s = s1 â§ B vl vl1"

definition Î2 :: "state â value list â state â value list â bool" where
"Î2 s vl s1 vl1 â¡
 (â cid. PID ââ paperIDs s cid â§ phase s cid = subPH) â§
 eqButPID s s1 â§ B vl vl1"


definition Î3 :: "state â value list â state â value list â bool" where
"Î3 s vl s1 vl1 â¡
 (â cid. PID ââ paperIDs s cid) â§ s = s1 â§ vl = [] â§ vl1 = []"


definition Îe :: "state â value list â state â value list â bool" where
"Îe s vl s1 vl1 â¡
 (â cid. PID ââ paperIDs s cid â§ phase s cid > subPH) â§ vl â  []"

lemma istate_Î1:
assumes B: "B vl vl1"
shows "Î1 istate vl istate vl1"
using assms unfolding Î1_def B_def istate_def by auto

lemma unwind_cont_Î1: "unwind_cont Î1 {Î1,Î2,Îe}"
proof(rule)
  let ?Î = "disjAll {Î1, Î2, Îe}"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Î1 s vl s1 vl1"
  hence rs: "reach s" and cid: "âcid. Â¬ PID ââ paperIDs s cid"
    and ss1: "s1 = s" and vl: "vl â  []" and vl1: "vl1 â  []" and vlvl1: "last vl = last vl1"
  using reachNT_reach unfolding Î1_def B_def by auto
  show "iaction ?Î s vl s1 vl1 â¨
        ((vl â  [] â¨ vl1 = []) â§ reaction ?Î s vl s1 vl1)" (is "?iact â¨ (_ â§ ?react)")
  proof -
    have "?react"
    proof (rule, goal_cases)
      case (1 a ou s' vl')
      assume STET: "step s a = (ou, s')" and "Â¬ T (Trans s a ou s')"
        and CONSUME: "consume (Trans s a ou s') vl vl'"

      have not_phi: "Â¬Ï (Trans s a ou s')"
        using STET cid
        by (auto simp: Ï_def2 u_defs)
      with CONSUME have vlvl': "vl'=vl"
        by (simp add: consume_def)

      have "match (disjAll {Î1, Î2, Îe}) s s1 vl1 a ou s' vl'"
      proof
        show "validTrans (Trans s1 a ou s')" using STET by (simp add: ss1)
        show "consume (Trans s1 a ou s') vl1 vl1"
          by (simp add: consume_def ss1 not_phi)

        show "Î³ (Trans s a ou s') = Î³ (Trans s1 a ou s')" by simp
        show "g (Trans s a ou s') = g (Trans s1 a ou s')" by simp
        show "disjAll {Î1, Î2, Îe} s' vl' s' vl1"
        proof (cases "âcid. PID ââ paperIDs s' cid")
          case False hence "Î1 s' vl' s' vl1"
            by (simp add: Î1_def B_def vlvl' vl vl1 vlvl1)
          thus ?thesis by simp
        next
          case True hence "Î2 s' vl' s' vl1"
            apply (simp add: Î2_def B_def vlvl' vl vl1 vlvl1)
            apply (erule exE)
            subgoal for cid apply(rule exI[of _ cid])
              apply simp
              apply (use STET cid in â¹cases aâº)
              subgoal for x1 apply(cases x1) apply(auto simp: c_defs) .
              subgoal for x2 apply(cases x2) apply(auto simp: u_defs) .
              subgoal for x3 apply(cases x3) apply(auto simp: uu_defs) .
              subgoal by simp
              subgoal by simp
              done
            done
          thus ?thesis by simp
        qed
      qed
      thus ?case by simp
    qed
    thus ?thesis using vl vl1 by auto
  qed
qed

lemma unwind_cont_Î2: "unwind_cont Î2 {Î2,Î3,Îe}"
proof (rule, goal_cases)
  case (1 s vl s1 vl1)
  assume rsT: "reachNT s" and rs1: "reach s1" and "Î2 s vl s1 vl1"
  then obtain cid where
    rs: "reach s" and pid: "PID ââ paperIDs s cid" and ph: "phase s cid = subPH"
    and ss1: "eqButPID s s1"
  and vl: "vl â  []" and vl1: "vl1 â  []" and vlvl1: "last vl = last vl1"
  using reachNT_reach unfolding Î2_def B_def by auto

  have cid: "cid ââ confIDs s"
    by (metis paperIDs_confIDs pid rs)

  from pid ph cid have
    pid1: "PID ââ paperIDs s1 cid"
    and ph1: "phase s1 cid = subPH"
    and cid1: "cid ââ confIDs s1"
    by (auto simp add: eqButPID_imp[OF ss1])

  show ?case (is "?iact â¨ (_ â§ ?react)")
  proof (cases "length vl1>1")
    case True then obtain v vl1' where [simp]: "vl1 = v#vl1'" "vl1'â []" by (cases vl1) auto

    obtain uid1 where aut1: "isAut s1 cid uid1 PID"
      thm paperID_ex_userID
      using paperID_ex_userID[OF rs1 pid1] by auto
    have uid1: "uid1 ââ userIDs s1"
      by (metis roles_userIDs rs1 aut1)

    from aut1 have "isAut s cid uid1 PID"
      using ss1 aut1 by (simp add: eqButPID_imp[OF ss1])
    with reachNT_non_isAut[OF rsT] uid1 have uid1_ne: "uid1âUIDs"
      by auto

    let ?a1 = "(Uact (uPaperC cid uid1 (pass s1 uid1) PID v))"
    obtain s1' where step: "step s1 ?a1 = (outOK,s1')" and s1's1: "eqButPID s1' s1"
      apply (simp add: u_defs cid1 uid1 pid1 ph1 aut1)
      apply (cases "paper s1 PID")
      apply (auto simp: eqButPID_def eeqButPID_def)
      done

    have "?iact"
    proof
      show "step s1 ?a1 = (outOK,s1')" using step .
      show "Ï (Trans s1 ?a1 outOK s1')" by simp
      show "consume (Trans s1 ?a1 outOK s1') vl1 vl1'" by (simp add: consume_def)
      show "Â¬Î³ (Trans s1 ?a1 outOK s1')" by (simp add: uid1_ne)
      have "Î2 s vl s1' vl1'" unfolding Î2_def B_def
        using vl vlvl1 ph pid
        apply simp_all
        by (metis s1's1 eqButPID_sym eqButPID_trans ss1)
      thus "disjAll {Î2, Î3, Îe} s vl s1' vl1'" by simp
    qed
    thus ?thesis by simp
  next
    case False then obtain v1 where [simp]: "vl1=[v1]" using vl1 by (cases vl1) auto

    have "?react"
    proof (rule, goal_cases)
      case (1 a ou s' vl')
      assume STET: "step s a = (ou, s')" and "Â¬ T (Trans s a ou s')"
        and CONSUME: "consume (Trans s a ou s') vl vl'"

      have ph': "phase s' cid â¥ subPH"
        by (smt STET ph phase_increases)

      have pid': "PID ââ paperIDs s' cid" using pid STET
        by (metis paperIDs_mono)

      {
        fix s1 vl1
        assume "phase s' cid â  subPH"
        hence "Îe s' vl' s1 vl1"
          unfolding Îe_def
          using STET CONSUME vl ph
          apply (cases a)
            subgoal for x1 apply(cases x1) apply(auto simp: c_defs) .
            subgoal for x2 apply(cases x2) apply(auto simp: u_defs consume_def pid) apply metis .
            subgoal for x3 apply(cases x3) apply(auto simp: uu_defs) .
            by simp_all
      } note Îe=this

      obtain s1' ou' where STET': "step s1 a = (ou',s1')" and s's1': "eqButPID s' s1'"
        using eqButPID_step[OF ss1 STET]
        by fastforce

      from eqButPID_step_Ï[OF ss1 STET STET']
      have Ï_eq: "Ï (Trans s1 a ou' s1') = Ï (Trans s a ou s')" by simp

      show ?case (is "?match â¨ ?ignore")
      proof (cases "Ï (Trans s a ou s')")
        case True note Ï=this

        then obtain cid' uid p where
          a[simp]: "a=Uact (uPaperC cid' uid p PID (hd vl))" "ou=outOK" using CONSUME
          by (cases "(Trans s a ou s')" rule: f.cases) (auto simp add: consume_def vl)

        from STET pid have [simp]: "cid'=cid"
          by (simp add: u_defs paperIDs_equals[OF rs])

        from Ï_step_eqButPID[OF Ï STET] have ss': "eqButPID s s'" .

        have nÎ³: "Â¬Î³ (Trans s a ou s')"
          using T_Ï_Î³[OF rsT STET] by simp

        have ph': "phase s' cid = subPH"
          using STET by (auto simp add: u_defs)

        show ?thesis proof (cases "length vl = 1")
          case True hence [simp]: "vl=[v1]" using vlvl1 by (cases vl) simp_all
          from CONSUME have [simp]: "vl'=[]" by (simp add: consume_def Ï)

          from STET STET' have [simp]: "s1'=s'"
          using eqButPID_step_eq ss1 a by blast

          have ?match proof
            show "validTrans (Trans s1 a ou' s1')" using STET' by simp
            show "consume (Trans s1 a ou' s1') vl1 []"
              using Ï Ï_eq CONSUME
              by (simp add: consume_def)
            show "Î³ (Trans s a ou s') = Î³ (Trans s1 a ou' s1')" by simp
            show "Î³ (Trans s a ou s') â¹ g (Trans s a ou s') = g (Trans s1 a ou' s1')"
              using nÎ³ by simp
            have "Î3 s' vl' s1' []"
              unfolding Î3_def
              using ph' pid'
              by force
            thus "disjAll {Î2, Î3, Îe} s' vl' s1' []" by simp
          qed
          thus ?thesis by simp
        next
          case False then obtain v where [simp]: "vl=v#vl'" "vl'â []"
            using CONSUME vl by (cases vl) (simp_all add: consume_def)
          have ?ignore
          proof
            show "Â¬ Î³ (Trans s a ou s')" by (rule nÎ³)
            have "Î2 s' vl' s1 vl1"
              unfolding Î2_def B_def
              using vlvl1 ph' pid' eqButPID_trans[OF eqButPID_sym[OF ss'] ss1]
              by auto
            thus "disjAll {Î2, Î3, Îe} s' vl' s1 vl1" by simp
          qed
          thus ?thesis by simp
        qed
      next
        case False note Ï=this
        with CONSUME have [simp]: "vl'=vl" by (simp add: consume_def)

        have ?match proof
          show "validTrans (Trans s1 a ou' s1')" using STET' by simp
          show "consume (Trans s1 a ou' s1') vl1 vl1" using Ï
            by (simp add: consume_def Ï_eq)
          show "Î³ (Trans s a ou s') = Î³ (Trans s1 a ou' s1')" by simp
          show "Î³ (Trans s a ou s') â¹ g (Trans s a ou s') = g (Trans s1 a ou' s1')"
            using eqButPID_step_out[OF ss1 STET STET' rsT rs1 pid ph]
            by simp
          show "disjAll {Î2, Î3, Îe} s' vl' s1' vl1"
          proof (cases "phase s' cid = subPH")
            case True
            hence "Î2 s' vl' s1' vl1"
              unfolding Î2_def B_def
              using eqButPID_step[OF ss1 STET STET']
              using ph' pid' vl vl1 vlvl1 by auto
            thus ?thesis by simp
          next
            case False
            hence "Îe s' vl' s1' vl1" using Îe by simp
            thus ?thesis by simp
          qed
        qed
        thus ?thesis by simp
      qed
    qed
    thus ?thesis using vl vl1 by simp
  qed
qed

lemma unwind_cont_Î3: "unwind_cont Î3 {Î3,Îe}"
proof (rule, goal_cases)
  case (1 s vl s1 vl1)
  assume rsT: "reachNT s" and rs1: "reach s1" and Î: "Î3 s vl s1 vl1"
  thm Î3_def
  then obtain cid where [simp]: "s1=s" "vl=[]" "vl1=[]"
    and pid: "PID ââ paperIDs s cid"
    unfolding Î3_def by auto

  thus ?case (is "_ â¨ (_ â§ ?react)")
  proof -
    have "?react"
    proof (rule, goal_cases)
      case (1 a ou s' vl')
      assume STET: "step s a = (ou, s')" and NT: "Â¬ T (Trans s a ou s')"
        and CONSUME: "consume (Trans s a ou s') vl vl'"
      have Î3: "Î3 s' vl' s' vl'" and [simp]: "vl'=[]"
        using CONSUME paperIDs_mono[OF STET pid]
        unfolding Î3_def
        by (auto simp add: consume_def)
      thus ?case (is "?match â¨ ?ignore")
      proof -
        have ?match
          apply (rule matchI[of s1 a ou s' vl1 vl1])
          using STET CONSUME Î3 by simp_all
        thus ?thesis by simp
      qed
    qed
    thus ?thesis by simp
  qed
qed

definition K1exit where
"K1exit s â¡ âcid. phase s cid > subPH â§ PID ââ paperIDs s cid"

lemma invarNT_K1exit: "invarNT K1exit"
  unfolding invarNT_def
  apply (safe dest!: reachNT_reach)
  subgoal for _ a apply(cases a)
    subgoal for x1 apply(cases x1) apply (auto simp: c_defs K1exit_def) .
    subgoal for x2 apply(cases x2) apply (auto simp: u_defs K1exit_def paperIDs_equals,force+) .
    subgoal for x3 apply(cases x3) apply (auto simp: uu_defs K1exit_def) .
    by simp_all
  done

lemma noVal_K1exit: "noVal K1exit v"
  apply(rule noÏ_noVal)
  unfolding noÏ_def apply safe
  subgoal for _ a apply(cases a)
    subgoal by simp
    subgoal for x2
      apply(cases x2, auto simp add: u_defs K1exit_def) []
      apply (metis reachNT_reach less_not_refl paperIDs_equals) .
    by simp_all
  done

lemma unwind_exit_Îe: "unwind_exit Îe"
proof
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and Îe: "Îe s vl s1 vl1"
  hence vl: "vl â  []" using reachNT_reach unfolding Îe_def by auto
  hence "K1exit s" using Îe unfolding K1exit_def Îe_def by auto
  thus "vl â  [] â§ exit s (hd vl)" apply(simp add: vl)
  by (metis rsT exitI2 invarNT_K1exit noVal_K1exit)
qed

theorem secure: secure
  apply(rule unwind_decomp3_secure[of Î1 Î2 Îe Î3])
  using
    istate_Î1
    unwind_cont_Î1 unwind_cont_Î2 unwind_cont_Î3
    unwind_exit_Îe
  by auto

end

Theory Review_Value_Setup

(* The value setup for reviewer confidentiality *)
theory Review_Value_Setup
imports Review_Intro
begin

consts PID :: paperID  consts N :: nat

text â¹\<^term>â¹(PID,N)âº identifies uniquely the review under scrutinyâº

subsection â¹Preliminariesâº

declare updates_commute_paper[simp]

text â¹Auxiliary definitions:âº

definition eqExcNth where
"eqExcNth xs ys n â¡
 length xs = length ys â§ (â i < length xs. i â  n â¶ xs!i = ys!i)"

lemma eqExcNth_eq[simp,intro!]: "eqExcNth xs xs n"
unfolding eqExcNth_def by auto

lemma eqExcNth_sym:
assumes "eqExcNth xs xs1 n"
shows "eqExcNth xs1 xs n"
using assms unfolding eqExcNth_def by auto

lemma eqExcNth_trans:
assumes "eqExcNth xs xs1 n" and "eqExcNth xs1 xs2 n"
shows "eqExcNth xs xs2 n"
using assms unfolding eqExcNth_def by auto

fun eqExcD :: "paper â paper â bool" where
"eqExcD (Paper name info ct reviews dis decs)
        (Paper name1 info1 ct1 reviews1 dis1 decs1) =
 (name = name1 â§ info = info1 â§ ct = ct1 â§ dis = dis1 â§ decs = decs1 â§
  eqExcNth reviews reviews1 N)"

lemma eqExcD:
"eqExcD pap pap1 =
 (titlePaper pap = titlePaper pap1 â§ abstractPaper pap = abstractPaper pap1 â§
  contentPaper pap = contentPaper pap1 â§
  disPaper pap = disPaper pap1 â§ decsPaper pap = decsPaper pap1 â§
  eqExcNth (reviewsPaper pap) (reviewsPaper pap1) N)"
by(cases pap, cases pap1, auto)

lemma eqExcD_eq[simp,intro!]: "eqExcD pap pap"
unfolding eqExcD using eqExcNth_eq by auto


lemma eqExcD_sym:
assumes "eqExcD pap pap1"
shows "eqExcD pap1 pap"
using assms unfolding eqExcD using eqExcNth_sym by auto

lemma eqExcD_trans:
assumes "eqExcD pap pap1" and "eqExcD pap1 pap2"
shows "eqExcD pap pap2"
using assms unfolding eqExcD using eqExcNth_trans by auto

definition eeqExcPID_N where
"eeqExcPID_N paps paps1 â¡
 â pid. if pid = PID then eqExcD (paps pid) (paps1 pid) else paps pid = paps1 pid"

lemma eeqExcPID_N_eeq[simp,intro!]: "eeqExcPID_N s s"
unfolding eeqExcPID_N_def by auto

lemma eeqExcPID_N_sym:
assumes "eeqExcPID_N s s1" shows "eeqExcPID_N s1 s"
using assms eqExcD_sym unfolding eeqExcPID_N_def by auto

lemma eeqExcPID_N_trans:
assumes "eeqExcPID_N s s1" and "eeqExcPID_N s1 s2" shows "eeqExcPID_N s s2"
using assms eqExcD_trans unfolding eeqExcPID_N_def by simp blast

lemma eeqExcPID_N_imp:
"eeqExcPID_N paps paps1 â¹ eqExcD (paps PID) (paps1 PID)"
"â¦eeqExcPID_N paps paps1; pid â  PIDâ§ â¹ paps pid = paps1 pid"
unfolding eeqExcPID_N_def by auto

lemma eeqExcPID_N_cong:
assumes "eeqExcPID_N paps paps1"
and "pid = PID â¹ eqExcD uu uu1"
and "pid â  PID â¹ uu = uu1"
shows "eeqExcPID_N (paps (pid := uu)) (paps1(pid := uu1))"
using assms unfolding eeqExcPID_N_def by auto

lemma eeqExcPID_N_RDD:
"eeqExcPID_N paps paps1 â¹
 titlePaper (paps PID) = titlePaper (paps1 PID) â§
 abstractPaper (paps PID) = abstractPaper (paps1 PID) â§
 contentPaper (paps PID) = contentPaper (paps1 PID) â§
 disPaper (paps PID) = disPaper (paps1 PID) â§
 decsPaper (paps PID) = decsPaper (paps1 PID)"
using eeqExcPID_N_def unfolding eqExcD by auto

text â¹The notion of two states being equal everywhere except on the the review \<^term>â¹(N,PID)âº:âº

definition eqExcPID_N :: "state â state â bool" where
"eqExcPID_N s s1 â¡
 confIDs s = confIDs s1 â§ conf s = conf s1 â§
 userIDs s = userIDs s1 â§ pass s = pass s1 â§ user s = user s1 â§ roles s = roles s1 â§
 paperIDs s = paperIDs s1
 â§
 eeqExcPID_N (paper s) (paper s1)
 â§
 pref s = pref s1 â§
 voronkov s = voronkov s1 â§
 news s = news s1 â§ phase s = phase s1"

lemma eqExcPID_N_eq[simp,intro!]: "eqExcPID_N s s"
unfolding eqExcPID_N_def by auto

lemma eqExcPID_N_sym:
assumes "eqExcPID_N s s1" shows "eqExcPID_N s1 s"
using assms eeqExcPID_N_sym unfolding eqExcPID_N_def by auto

lemma eqExcPID_N_trans:
assumes "eqExcPID_N s s1" and "eqExcPID_N s1 s2" shows "eqExcPID_N s s2"
using assms eeqExcPID_N_trans unfolding eqExcPID_N_def by auto

text â¹Implications from \<^term>â¹eqExcPID_Nâº, including w.r.t. auxiliary operations:âº

lemma eqExcPID_N_imp:
"eqExcPID_N s s1 â¹
 confIDs s = confIDs s1 â§ conf s = conf s1 â§
 userIDs s = userIDs s1 â§ pass s = pass s1 â§ user s = user s1 â§ roles s = roles s1 â§
 paperIDs s = paperIDs s1
 â§
 eeqExcPID_N (paper s) (paper s1)
 â§
 pref s = pref s1 â§
 voronkov s = voronkov s1 â§
 news s = news s1 â§ phase s = phase s1 â§

 getAllPaperIDs s = getAllPaperIDs s1 â§
 isRev s cid uid pid = isRev s1 cid uid pid â§
 getReviewIndex s cid uid pid = getReviewIndex s1 cid uid pid â§
 getRevRole s cid uid pid = getRevRole s1 cid uid pid â§
 length (reviewsPaper (paper s pid)) = length (reviewsPaper (paper s1 pid))"
unfolding eqExcPID_N_def getAllPaperIDs_def
unfolding isRev_def getReviewIndex_def getRevRole_def apply auto
unfolding eeqExcPID_N_def eqExcD eqExcNth_def by (cases "pid = PID") auto

lemma eqExcPID_N_imp1:
"eqExcPID_N s s1 â¹ eqExcD (paper s pid) (paper s1 pid)"
"eqExcPID_N s s1 â¹ pid â  PID â¨ PID â  pid â¹
    paper s pid = paper s1 pid â§
    getNthReview s pid n = getNthReview s1 pid n"
unfolding eqExcPID_N_def eeqExcPID_N_def getNthReview_def
apply auto by (metis eqExcD_eq)

lemma eqExcPID_N_imp2:
assumes "eqExcPID_N s s1" and "pid â  PID â¨ PID â  pid"
shows "getReviewersReviews s cid pid = getReviewersReviews s1 cid pid"
proof-
  have
  "(Î»uID. if isRev s cid uID pid then [(uID, getNthReview s pid (getReviewIndex s cid uID pid))] else []) =
   (Î»uID. if isRev s1 cid uID pid then [(uID, getNthReview s1 pid (getReviewIndex s1 cid uID pid))] else [])"
  apply(rule ext)
  using assms by (auto simp: eqExcPID_N_imp eqExcPID_N_imp1)
  thus ?thesis unfolding getReviewersReviews_def using assms by (simp add: eqExcPID_N_imp)
qed

lemma eqExcPID_N_imp3:
"eqExcPID_N s s1 â¹ pid â  PID â¨ PID â  pid â¨ (n < length (reviewsPaper (paper s PID)) â§ n â  N)
 â¹
 getNthReview s pid n = getNthReview s1 pid n"
  unfolding eqExcPID_N_def
  apply auto
   apply (metis eeqExcPID_N_imp(2) getNthReview_def)
  unfolding eeqExcPID_N_def apply simp unfolding eqExcD eqExcNth_def
  by (metis getNthReview_def)


lemma eqExcPID_N_imp3':
assumes s: "reach s"
and "eqExcPID_N s s1" and "pid â  PID â¨ (isRevNth s cid uid pid n â§ n â  N)"
shows "getNthReview s pid n = getNthReview s1 pid n"
proof-
  have "isRevNth s cid uid pid n â¹ pid â  PID â¨ n < length (reviewsPaper (paper s PID))"
  using s by (metis isRevNth_less_length)
  thus ?thesis using eqExcPID_N_imp3 assms by auto
qed

lemma eqExcPID_N_RDD:
"eqExcPID_N s s1 â¹
 titlePaper (paper s PID) = titlePaper (paper s1 PID) â§
 abstractPaper (paper s PID) = abstractPaper (paper s1 PID) â§
 contentPaper (paper s PID) = contentPaper (paper s1 PID) â§
 disPaper (paper s PID) = disPaper (paper s1 PID) â§
 decsPaper (paper s PID) = decsPaper (paper s1 PID)"
using eqExcPID_N_imp eeqExcPID_N_RDD by auto

lemma eqExcPID_N_cong[simp, intro]:
"â uu1 uu2. eqExcPID_N s s1 â¹ uu1 = uu2 â¹ eqExcPID_N (s â¦confIDs := uu1â¦) (s1 â¦confIDs := uu2â¦)"
"â uu1 uu2. eqExcPID_N s s1 â¹ uu1 = uu2 â¹ eqExcPID_N (s â¦conf := uu1â¦) (s1 â¦conf := uu2â¦)"

"â uu1 uu2. eqExcPID_N s s1 â¹ uu1 = uu2 â¹ eqExcPID_N (s â¦userIDs := uu1â¦) (s1 â¦userIDs := uu2â¦)"
"â uu1 uu2. eqExcPID_N s s1 â¹ uu1 = uu2 â¹ eqExcPID_N (s â¦pass := uu1â¦) (s1 â¦pass := uu2â¦)"
"â uu1 uu2. eqExcPID_N s s1 â¹ uu1 = uu2 â¹ eqExcPID_N (s â¦user := uu1â¦) (s1 â¦user := uu2â¦)"
"â uu1 uu2. eqExcPID_N s s1 â¹ uu1 = uu2 â¹ eqExcPID_N (s â¦roles := uu1â¦) (s1 â¦roles := uu2â¦)"

"â uu1 uu2. eqExcPID_N s s1 â¹ uu1 = uu2 â¹ eqExcPID_N (s â¦paperIDs := uu1â¦) (s1 â¦paperIDs := uu2â¦)"
"â uu1 uu2. eqExcPID_N s s1 â¹ eeqExcPID_N uu1 uu2 â¹ eqExcPID_N (s â¦paper := uu1â¦) (s1 â¦paper := uu2â¦)"

"â uu1 uu2. eqExcPID_N s s1 â¹ uu1 = uu2 â¹ eqExcPID_N (s â¦pref := uu1â¦) (s1 â¦pref := uu2â¦)"
"â uu1 uu2. eqExcPID_N s s1 â¹ uu1 = uu2 â¹ eqExcPID_N (s â¦voronkov := uu1â¦) (s1 â¦voronkov := uu2â¦)"
"â uu1 uu2. eqExcPID_N s s1 â¹ uu1 = uu2 â¹ eqExcPID_N (s â¦news := uu1â¦) (s1 â¦news := uu2â¦)"
"â uu1 uu2. eqExcPID_N s s1 â¹ uu1 = uu2 â¹ eqExcPID_N (s â¦phase := uu1â¦) (s1 â¦phase := uu2â¦)"

unfolding eqExcPID_N_def by auto

lemma eqExcPID_N_Paper:
assumes s's1': "eqExcPID_N s s1"
and "paper s pid = Paper title abstract content reviews dis decs"
and "paper s1 pid = Paper title1 abstract1 content1 reviews1 dis1 decs1"
shows "title = title1 â§ abstract = abstract1 â§ content = content1 â§ dis = dis1 â§ decs = decs1"
using assms unfolding eqExcPID_N_def apply (auto simp: eqExcD eeqExcPID_N_def)
by (metis titlePaper.simps abstractPaper.simps contentPaper.simps disPaper.simps decsPaper.simps)+

text â¹Auxiliary definitions for a slightly weaker equivalence relation defined below:âº

definition eqExcNth2 where
"eqExcNth2 rl rl1 n â¡
 length rl = length rl1 â§
 (â i < length rl. i â  n â¶ rl!i = rl1!i) â§
 hd (rl!n) = hd (rl1!n)"

lemma eqExcNth2_eq[simp,intro!]: "eqExcNth2 rl rl n"
unfolding eqExcNth2_def by auto

lemma eqExcNth2_sym:
assumes "eqExcNth2 rl rl1 n"
shows "eqExcNth2 rl1 rl n"
using assms unfolding eqExcNth2_def by auto

lemma eqExcNth2_trans:
assumes "eqExcNth2 rl rl1 n" and "eqExcNth2 rl1 rl2 n"
shows "eqExcNth2 rl rl2 n"
using assms unfolding eqExcNth2_def by auto

fun eqExcD2 :: "paper â paper â bool" where
"eqExcD2 (Paper title abstract ct reviews dis decs)
         (Paper title1 abstract1 ct1 reviews1 dis1 decs1) =
 (title = title1 â§ abstract = abstract1 â§ ct = ct1 â§ dis = dis1 â§ decs = decs1 â§
  eqExcNth2 reviews reviews1 N)"

lemma eqExcD2:
"eqExcD2 pap pap1 =
 (titlePaper pap = titlePaper pap1 â§ abstractPaper pap = abstractPaper pap1 â§
  contentPaper pap = contentPaper pap1 â§
  disPaper pap = disPaper pap1 â§ decsPaper pap = decsPaper pap1 â§
  eqExcNth2 (reviewsPaper pap) (reviewsPaper pap1) N)"
by(cases pap, cases pap1, auto)

lemma eqExcD2_eq[simp,intro!]: "eqExcD2 pap pap"
unfolding eqExcD2 using eqExcNth2_eq by auto

lemma eqExcD2_sym:
assumes "eqExcD2 pap pap1"
shows "eqExcD2 pap1 pap"
using assms unfolding eqExcD2 using eqExcNth2_sym by auto

lemma eqExcD2_trans:
assumes "eqExcD2 pap pap1" and "eqExcD2 pap1 pap2"
shows "eqExcD2 pap pap2"
using assms unfolding eqExcD2 using eqExcNth2_trans by auto

definition eeqExcPID_N2 where
"eeqExcPID_N2 paps paps1 â¡
 â pid. if pid = PID then eqExcD2 (paps pid) (paps1 pid) else paps pid = paps1 pid"

lemma eeqExcPID_N2_eeq[simp,intro!]: "eeqExcPID_N2 s s"
unfolding eeqExcPID_N2_def by auto

lemma eeqExcPID_N2_sym:
assumes "eeqExcPID_N2 s s1" shows "eeqExcPID_N2 s1 s"
using assms eqExcD2_sym unfolding eeqExcPID_N2_def by auto

lemma eeqExcPID_N2_trans:
assumes "eeqExcPID_N2 s s1" and "eeqExcPID_N2 s1 s2" shows "eeqExcPID_N2 s s2"
using assms eqExcD2_trans unfolding eeqExcPID_N2_def by simp blast

lemma eeqExcPID_N2_imp:
"eeqExcPID_N2 paps paps1 â¹ eqExcD2 (paps PID) (paps1 PID)"
"â¦eeqExcPID_N2 paps paps1; pid â  PIDâ§ â¹ paps pid = paps1 pid"
unfolding eeqExcPID_N2_def by auto

lemma eeqExcPID_N2_cong:
assumes "eeqExcPID_N2 paps paps1"
and "pid = PID â¹ eqExcD2 uu uu1"
and "pid â  PID â¹ uu = uu1"
shows "eeqExcPID_N2 (paps (pid := uu)) (paps1(pid := uu1))"
using assms unfolding eeqExcPID_N2_def by auto

lemma eeqExcPID_N2_RDD:
"eeqExcPID_N2 paps paps1 â¹
 titlePaper (paps PID) = titlePaper (paps1 PID) â§
 abstractPaper (paps PID) = abstractPaper (paps1 PID) â§
 contentPaper (paps PID) = contentPaper (paps1 PID) â§
 disPaper (paps PID) = disPaper (paps1 PID) â§
 decsPaper (paps PID) = decsPaper (paps1 PID)"
using eeqExcPID_N2_def unfolding eqExcD2 by auto

text â¹A weaker state equivalence that allows differences in old versions of the score and comments
of the review \<^term>â¹(N, PID)âº.  It is used for the confidentiality property that does not cover
PC members in the discussion phase, when they will learn about scores and comments.âº

definition eqExcPID_N2 :: "state â state â bool" where
"eqExcPID_N2 s s1 â¡
 confIDs s = confIDs s1 â§ conf s = conf s1 â§
 userIDs s = userIDs s1 â§ pass s = pass s1 â§ user s = user s1 â§ roles s = roles s1 â§
 paperIDs s = paperIDs s1
 â§
 eeqExcPID_N2 (paper s) (paper s1)
 â§
 pref s = pref s1 â§
 voronkov s = voronkov s1 â§
 news s = news s1 â§ phase s = phase s1"

lemma eqExcPID_N2_eq[simp,intro!]: "eqExcPID_N2 s s"
unfolding eqExcPID_N2_def by auto

lemma eqExcPID_N2_sym:
assumes "eqExcPID_N2 s s1" shows "eqExcPID_N2 s1 s"
using assms eeqExcPID_N2_sym unfolding eqExcPID_N2_def by auto

lemma eqExcPID_N2_trans:
assumes "eqExcPID_N2 s s1" and "eqExcPID_N2 s1 s2" shows "eqExcPID_N2 s s2"
using assms eeqExcPID_N2_trans unfolding eqExcPID_N2_def by auto

text â¹Implications from \<^term>â¹eqExcPID_N2âº, including w.r.t. auxiliary operations:âº

lemma eqExcPID_N2_imp:
"eqExcPID_N2 s s1 â¹
 confIDs s = confIDs s1 â§ conf s = conf s1 â§
 userIDs s = userIDs s1 â§ pass s = pass s1 â§ user s = user s1 â§ roles s = roles s1 â§
 paperIDs s = paperIDs s1
 â§
 eeqExcPID_N2 (paper s) (paper s1)
 â§
 pref s = pref s1 â§
 voronkov s = voronkov s1 â§
 news s = news s1 â§ phase s = phase s1 â§

 getAllPaperIDs s = getAllPaperIDs s1 â§
 isRev s cid uid pid = isRev s1 cid uid pid â§
 getReviewIndex s cid uid pid = getReviewIndex s1 cid uid pid â§
 getRevRole s cid uid pid = getRevRole s1 cid uid pid â§
 length (reviewsPaper (paper s pid)) = length (reviewsPaper (paper s1 pid))"
unfolding eqExcPID_N2_def getAllPaperIDs_def
unfolding isRev_def getReviewIndex_def getRevRole_def apply auto
unfolding eeqExcPID_N2_def eqExcD2 eqExcNth2_def by simp metis

lemma eqExcPID_N2_imp1:
"eqExcPID_N2 s s1 â¹ eqExcD2 (paper s pid) (paper s1 pid)"
"eqExcPID_N2 s s1 â¹ pid â  PID â¨ PID â  pid â¹
    paper s pid = paper s1 pid â§
    getNthReview s pid n = getNthReview s1 pid n"
unfolding eqExcPID_N2_def getNthReview_def eeqExcPID_N2_def
apply auto
by (metis eqExcD2_eq)

lemma eqExcPID_N2_imp2:
assumes "eqExcPID_N2 s s1" and "pid â  PID â¨ PID â  pid"
shows "getReviewersReviews s cid pid = getReviewersReviews s1 cid pid"
proof-
  have
  "(Î»uID. if isRev s cid uID pid then [(uID, getNthReview s pid (getReviewIndex s cid uID pid))] else []) =
   (Î»uID. if isRev s1 cid uID pid then [(uID, getNthReview s1 pid (getReviewIndex s1 cid uID pid))] else [])"
  apply(rule ext)
  using assms by (auto simp: eqExcPID_N2_imp eqExcPID_N2_imp1)
  thus ?thesis unfolding getReviewersReviews_def using assms by (simp add: eqExcPID_N2_imp)
qed

lemma eqExcPID_N2_eqExcPID_N:
"eqExcPID_N2 s s1 â¹ eqExcPID_N s s1"
unfolding eqExcPID_N_def eqExcPID_N2_def eeqExcPID_N_def eeqExcPID_N2_def eqExcD2 eqExcD
by (auto simp: eqExcNth_def eqExcNth2_def)

lemma eqExcPID_N2_imp3:
"eqExcPID_N2 s s1 â¹ pid â  PID â¨ PID â  pid â¨ (n < length (reviewsPaper (paper s PID)) â§ n â  N)
 â¹
 getNthReview s pid n = getNthReview s1 pid n"
by (metis eqExcPID_N2_eqExcPID_N eqExcPID_N_imp3)

lemma eqExcPID_N2_imp3':
assumes s: "reach s"
and "eqExcPID_N2 s s1" and "pid â  PID â¨ (isRevNth s cid uid pid n â§ n â  N)"
shows "getNthReview s pid n = getNthReview s1 pid n"
by (metis assms eqExcPID_N2_eqExcPID_N eqExcPID_N_imp3')

lemma eqExcPID_N2_imp33:
assumes "eqExcPID_N2 s s1"
shows "hd (getNthReview s pid N) = hd (getNthReview s1 pid N)"
proof(cases "pid = PID")
  case False thus ?thesis using eqExcPID_N2_imp3[OF assms] by auto
next
  case True thus ?thesis apply simp
  using assms unfolding eqExcPID_N2_def eeqExcPID_N2_def eqExcD2 eqExcNth2_def getNthReview_def by auto
qed


lemma eqExcPID_N2_RDD:
"eqExcPID_N2 s s1 â¹
 titlePaper (paper s PID) = titlePaper (paper s1 PID) â§
 abstractPaper (paper s PID) = abstractPaper (paper s1 PID) â§
 contentPaper (paper s PID) = contentPaper (paper s1 PID) â§
 disPaper (paper s PID) = disPaper (paper s1 PID) â§
 decsPaper (paper s PID) = decsPaper (paper s1 PID)"
using eqExcPID_N2_imp eeqExcPID_N2_RDD by auto

lemma eqExcPID_N2_cong[simp, intro]:
"â uu1 uu2. eqExcPID_N2 s s1 â¹ uu1 = uu2 â¹ eqExcPID_N2 (s â¦confIDs := uu1â¦) (s1 â¦confIDs := uu2â¦)"
"â uu1 uu2. eqExcPID_N2 s s1 â¹ uu1 = uu2 â¹ eqExcPID_N2 (s â¦conf := uu1â¦) (s1 â¦conf := uu2â¦)"

"â uu1 uu2. eqExcPID_N2 s s1 â¹ uu1 = uu2 â¹ eqExcPID_N2 (s â¦userIDs := uu1â¦) (s1 â¦userIDs := uu2â¦)"
"â uu1 uu2. eqExcPID_N2 s s1 â¹ uu1 = uu2 â¹ eqExcPID_N2 (s â¦pass := uu1â¦) (s1 â¦pass := uu2â¦)"
"â uu1 uu2. eqExcPID_N2 s s1 â¹ uu1 = uu2 â¹ eqExcPID_N2 (s â¦user := uu1â¦) (s1 â¦user := uu2â¦)"
"â uu1 uu2. eqExcPID_N2 s s1 â¹ uu1 = uu2 â¹ eqExcPID_N2 (s â¦roles := uu1â¦) (s1 â¦roles := uu2â¦)"

"â uu1 uu2. eqExcPID_N2 s s1 â¹ uu1 = uu2 â¹ eqExcPID_N2 (s â¦paperIDs := uu1â¦) (s1 â¦paperIDs := uu2â¦)"
"â uu1 uu2. eqExcPID_N2 s s1 â¹ eeqExcPID_N2 uu1 uu2 â¹ eqExcPID_N2 (s â¦paper := uu1â¦) (s1 â¦paper := uu2â¦)"

"â uu1 uu2. eqExcPID_N2 s s1 â¹ uu1 = uu2 â¹ eqExcPID_N2 (s â¦pref := uu1â¦) (s1 â¦pref := uu2â¦)"
"â uu1 uu2. eqExcPID_N2 s s1 â¹ uu1 = uu2 â¹ eqExcPID_N2 (s â¦voronkov := uu1â¦) (s1 â¦voronkov := uu2â¦)"
"â uu1 uu2. eqExcPID_N2 s s1 â¹ uu1 = uu2 â¹ eqExcPID_N2 (s â¦news := uu1â¦) (s1 â¦news := uu2â¦)"
"â uu1 uu2. eqExcPID_N2 s s1 â¹ uu1 = uu2 â¹ eqExcPID_N2 (s â¦phase := uu1â¦) (s1 â¦phase := uu2â¦)"

unfolding eqExcPID_N2_def by auto

lemma eqExcPID_N2_Paper:
assumes s's1': "eqExcPID_N2 s s1"
and "paper s pid = Paper title abstract content reviews dis decs"
and "paper s1 pid = Paper title1 abstract1 content1 reviews1 dis1 decs1"
shows "title = title1 â§ abstract = abstract1 â§ content = content1 â§ dis = dis1 â§ decs = decs1"
using assms unfolding eqExcPID_N2_def apply (auto simp: eqExcD2 eeqExcPID_N2_def)
by (metis titlePaper.simps abstractPaper.simps contentPaper.simps disPaper.simps decsPaper.simps)+


(* major *) lemma eqExcPID_N2_step:
assumes ss1: "eqExcPID_N2 s s1"
and step: "step s a = (ou,s')"
and step1: "step s1 a = (ou1,s1')"
and s: "reach s" and r: "isRevNth s cid uid PID N" (* new *)
shows "eqExcPID_N2 s' s1'"
proof -
  note eqs = eqExcPID_N2_imp[OF ss1]
  note eqs' = eqExcPID_N2_imp1[OF ss1]
  have r: "N < length (reviewsPaper (paper s PID))" using s r by (metis isRevNth_less_length)
  have r1: "N < length (reviewsPaper (paper s1 PID))"
  using r eqs unfolding eeqExcPID_N2_def eqExcD2 eqExcNth2_def by simp

  note simps[simp] = c_defs u_defs uu_defs r_defs l_defs Paper_dest_conv eqExcPID_N2_def eeqExcPID_N2_def eqExcD2 eqExcNth2_def
  note * = step step1 eqs eqs' r r1

  then show ?thesis
  proof (cases a)
    case (Cact x1)
    with * show ?thesis
    proof (cases x1)
      case (cReview x81 x82 x83 x84 x85)
      with Cact * show ?thesis
        by (clarsimp; metis (no_types, lifting) less_SucE nth_append_length right_cons_left)
    qed auto
  next
    case (Uact x2)
    with * show ?thesis
    proof (cases x2)
      case (uReview x71 x72 x73 x74 x75 x76)
      with Uact * show ?thesis
        by (clarsimp; metis (no_types, lifting) nth_list_update nth_list_update_neq)
    qed auto
  next
    case (UUact x3)
    with * show ?thesis
    proof (cases x3)
      case (uuReview x31 x32 x33 x34 x35 x36)
      with UUact * show ?thesis
        by (clarsimp; smt list.sel(1) nth_list_update nth_list_update_neq)
    qed auto
  qed auto
qed


subsection â¹Value Setupâº

fun Ï :: "(state,act,out) trans â bool" where
"Ï (Trans _ (Uact (uReview cid uid p pid n rc)) ou _) =
 (pid = PID â§ n = N â§ ou = outOK)"
|
"Ï (Trans _ (UUact (uuReview cid uid p pid n rc)) ou _) =
 (pid = PID â§ n = N â§ ou = outOK)"
|
"Ï _ = False"

lemma Ï_def2:
"Ï (Trans s a ou s') =
 (ou = outOK â§
 (â cid uid p rc.
     a = Uact (uReview cid uid p PID N rc)
     â¨
    a = UUact (uuReview cid uid p PID N rc)
 ))"
  apply(cases a)
  subgoal by simp
  subgoal for x2 apply (cases x2, auto) .
  subgoal for x3  apply(cases x3, auto) .
  by simp_all

lemma uReview_uuReview_step_eqExcPID_N:
assumes a:
"a = Uact (uReview cid uid p PID N rc) â¨
 a = UUact (uuReview cid uid p PID N rc)"
and "step s a = (ou,s')"
shows "eqExcPID_N s s'"
using assms unfolding eqExcPID_N_def eeqExcPID_N_def by (auto simp: u_defs uu_defs eqExcNth_def)

lemma Ï_step_eqExcPID_N:
assumes Ï: "Ï (Trans s a ou s')"
and s: "step s a = (ou,s')"
shows "eqExcPID_N s s'"
using Ï uReview_uuReview_step_eqExcPID_N[OF _ s] unfolding Ï_def2 by blast

(* major *) lemma eqExcPID_N_step:
assumes s's1': "eqExcPID_N s s1"
and step: "step s a = (ou,s')"
and step1: "step s1 a = (ou1,s1')"
shows "eqExcPID_N s' s1'"
proof -
  note eqs = eqExcPID_N_imp[OF s's1']
  note eqs' = eqExcPID_N_imp1[OF s's1']

  note simps[simp] = c_defs u_defs uu_defs r_defs l_defs Paper_dest_conv eqExcPID_N_def eeqExcPID_N_def eqExcD eqExcNth_def
  note * = step step1 eqs eqs'

  then show ?thesis
  proof (cases a)
    case (Cact x1)
    with * show ?thesis
    proof (cases x1)
      case (cReview x81 x82 x83 x84 x85)
      with Cact * show ?thesis
        by (clarsimp; metis (no_types, lifting) less_SucE nth_append_length right_cons_left)
    qed auto
  next
    case (Uact x2)
    with * show ?thesis
    proof (cases x2)
      case (uReview x71 x72 x73 x74 x75 x76)
      with Uact * show ?thesis
        by (clarsimp; metis (no_types, lifting) nth_list_update nth_list_update_neq)
    qed auto
  next
    case (UUact x3)
    with * show ?thesis
    proof (cases x3)
      case (uuReview x31 x32 x33 x34 x35 x36)
      with UUact * show ?thesis
        by (clarsimp; metis (no_types, lifting) nth_list_update nth_list_update_neq)
    qed auto
  qed auto
qed

lemma eqExcPID_N_step_Ï_imp:
assumes ss1: "eqExcPID_N s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and Ï: "Ï (Trans s a ou s')"
shows "Ï (Trans s1 a ou1 s1')"
using assms unfolding Ï_def2 by (auto simp add: u_defs uu_defs eqExcPID_N_imp)

lemma eqExcPID_N_step_Ï:
assumes s's1': "eqExcPID_N s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
shows "Ï (Trans s a ou s') = Ï (Trans s1 a ou1 s1')"
by (metis eqExcPID_N_step_Ï_imp eqExcPID_N_sym assms)

lemma eqExcPID_N2_step_Ï_imp:
assumes ss1: "eqExcPID_N2 s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and r: "N < length (reviewsPaper (paper s PID))" (* new *)
and Ï: "Ï (Trans s a ou s')"
shows "Ï (Trans s1 a ou1 s1')"
using assms unfolding Ï_def2 by (auto simp add: u_defs uu_defs eqExcPID_N2_imp)

(* More complex, roundabout proof than for other types of documents: *)
lemma eqExcPID_N2_step_Ï:
assumes s: "reach s" and s1: "reach s1"
and ss1: "eqExcPID_N2 s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
shows "Ï (Trans s a ou s') = Ï (Trans s1 a ou1 s1')"
proof(cases "â cid uid. isRevNth s cid uid PID N")
  case False
  hence "Â¬ Ï (Trans s a ou s')" unfolding Ï_def2 using step
  by (auto simp add: u_defs uu_defs) (metis isRev_imp_isRevNth_getReviewIndex)+
  moreover have "Â¬ Ï (Trans s1 a ou1 s1')" using step1 False unfolding Ï_def2
  by (auto simp add: u_defs uu_defs) (metis eqExcPID_N2_def isRev_imp_isRevNth_getReviewIndex ss1)+
  ultimately show ?thesis by auto
next
  case True note r = True
  note eqs = eqExcPID_N2_imp[OF ss1]
  have r: "N < length (reviewsPaper (paper s PID))"
  using isRevNth_less_length[OF s] r by auto
  have r1: "N < length (reviewsPaper (paper s1 PID))"
  using eqs r unfolding eeqExcPID_N2_def eqExcD2 eqExcNth2_def by simp
  thus ?thesis by (metis eqExcPID_N2_step_Ï_imp eqExcPID_N2_sym assms r)
qed

end

Theory Review_RAut

theory Review_RAut
imports "../Observation_Setup" Review_Value_Setup "Bounded_Deducibility_Security.Compositional_Reasoning"
begin

subsection â¹Confidentiality protection from users who are not the review's authorâº


text â¹We verify the following property:

\ \\
A group UIDs of users learn nothing
about the various updates of the N'th review of a paper PID
except for the last edited version before discussion and all the later versions
unless a user in UIDs is that review's author.

\ \\
âº

type_synonym "value" = "phase * rcontent"

fun f :: "(state,act,out) trans â value" where
"f (Trans s (Uact (uReview cid uid p pid n rc)) _ _) = (phase s cid, rc)"
|
"f (Trans s (UUact (uuReview cid uid p pid n rc)) _ _) = (phase s cid, rc)"

fun T :: "(state,act,out) trans â bool" where
"T (Trans _ _ ou s') =
 (â uid â UIDs. isREVNth s' uid PID N)"

declare T.simps [simp del]

definition B :: "value list â value list â bool" where
"B vl vl1 â¡
 â ul ul1 wl.
   vl = (map (Pair revPH) ul) @ (map (Pair disPH) wl) â§
   vl1 = (map (Pair revPH) ul1) @ (map (Pair disPH) wl) â§
   ul â  [] â§ ul1 â  [] â§ last ul = last ul1"

interpretation BD_Security_IO where
istate = istate and step = step and
Ï = Ï and f = f and Î³ = Î³ and g = g and T = T and B = B
done

lemma reachNT_non_isRevNth:
assumes "reachNT s" and "uid â UIDs"
shows "Â¬ isRevNth s cid uid PID N"
  using assms
  apply induct
   apply (auto simp: istate_def)[]
  subgoal for trn apply(cases trn, auto simp: T.simps reachNT_reach isREVNth_def) .
  done


(* important: *) lemma P_Ï_Î³:
assumes 1: "reachNT s" and 2: "step s a = (ou,s')" "Ï (Trans s a ou s')"
shows "Â¬ Î³ (Trans s a ou s')"
using reachNT_non_isRevNth[OF 1] 2 unfolding T.simps Ï_def2
apply (auto simp add: u_defs uu_defs) by (metis isRev_imp_isRevNth_getReviewIndex)+

(* major *) lemma eqExcPID_N_step_out:
assumes s's1': "eqExcPID_N s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and sT: "reachNT s" and s1: "reach s1"
and PID: "PID ââ paperIDs s cid"
and ph: "phase s cid = revPH"
and UIDs: "userOfA a â UIDs"
shows "ou = ou1"
proof-
  note Inv = reachNT_non_isRevNth[OF sT UIDs]
  note eqs = eqExcPID_N_imp[OF s's1']
  note eqs' = eqExcPID_N_imp1[OF s's1']
  note s = reachNT_reach[OF sT]

  note simps[simp] = c_defs u_defs uu_defs r_defs l_defs Paper_dest_conv eqExcPID_N_def eeqExcPID_N_def eqExcD
  note * = step step1 eqs eqs' s s1 PID UIDs ph paperIDs_equals[OF s] Inv

  show ?thesis
  proof (cases a)
    case (Cact x1)
    with * show ?thesis by (cases x1; auto)
  next
    case (Uact x2)
    with * show ?thesis by (cases x2; auto)
  next
    case (UUact x3)
    with * show ?thesis by (cases x3; auto)
  next
    case (Ract x4)
    with * show ?thesis
    proof (cases x4)
      case (rMyReview x81 x82 x83 x84)
      with Ract * show ?thesis
        by clarsimp (metis eqExcPID_N_imp3' getRevRole_Some_Rev_isRevNth s's1')
    next
      case (rReviews x91 x92 x93 x94)
      with Ract * show ?thesis
        by clarsimp (metis Suc_n_not_le_n eqExcPID_N_imp2 s's1')
    next
      case (rFinalReviews x121 x122 x123 x124)
      with Ract * show ?thesis
        by clarsimp (metis Suc_leD Suc_n_not_le_n)
    qed auto
  next
    case (Lact x5)
    with * show ?thesis by (cases x5; auto; presburger)
  qed
qed

lemma eeqExcPID_N_imp_eq:
assumes "eeqExcPID_N paps paps1"
and "reviewsPaper (paps PID) ! N = reviewsPaper (paps1 PID) ! N"
shows "paps = paps1"
proof(rule ext)
  fix pid
  show "paps pid = paps1 pid"
  using assms unfolding eeqExcPID_N_def eqExcD eqExcNth_def
  apply(cases "paps PID", cases "paps1 PID", cases "pid = PID")
  by simp_all (metis nth_equalityI)
qed

lemma eqExcPID_N_imp_eq:
assumes e: "eqExcPID_N s s1"
and "reviewsPaper (paper s PID) ! N = reviewsPaper (paper s1 PID) ! N"
shows "s = s1"
proof-
  have "paper s = paper s1" using assms eeqExcPID_N_imp_eq
  unfolding eqExcPID_N_def by metis
  thus ?thesis
  using e unfolding eqExcPID_N_def by (intro state.equality) auto
qed


(* major *) lemma eqExcPID_N_step_eq:
assumes s: "reach s" and ss1: "eqExcPID_N s s1"
and a: "a = Uact (uReview cid uid p PID N rc)"
and step: "step s a = (outOK, s')" and step1: "step s1 a = (ou', s1')"
shows "s' = s1'"
proof(cases "â cid uid. isRevNth s cid uid PID N")
  case False
  hence False
  using step unfolding a
  by (auto simp add: u_defs uu_defs) (metis isRev_imp_isRevNth_getReviewIndex)+
  thus ?thesis by auto
next
  case True note r = True
  note eqs = eqExcPID_N_imp[OF ss1]
  note eqsT = eqExcPID_N_Paper[OF ss1]
  have r: "N < length (reviewsPaper (paper s PID))"
  using isRevNth_less_length[OF s] r by auto
  have r1: "N < length (reviewsPaper (paper s1 PID))"
  using eqs r unfolding eeqExcPID_N_def eqExcD eqExcNth_def by simp
  have s's1': "eqExcPID_N s' s1'" using assms by (metis eqExcPID_N_step)

  have "e_updateReview s cid uid p PID N rc"
  using step a by auto
  hence "e_updateReview s1 cid uid p PID N rc"
  using eqExcPID_N_imp[OF ss1] u_defs by auto
  hence ou': "ou' = outOK" using step1 a by auto

  let ?p = "paper s PID" let ?p1 = "paper s1 PID"

  have 1: "eqExcD ?p ?p1"
  using ss1 eqExcPID_N_imp unfolding eeqExcPID_N_def by auto

  have 2: "reviewsPaper (paper s' PID) ! N = reviewsPaper (paper s1' PID) ! N"
  using step step1[unfolded ou'] r r1 unfolding a
  by (cases ?p, cases ?p1) (auto simp : u_defs)

  from 1 2 show ?thesis using eqExcPID_N_imp_eq s's1' by blast
qed

definition Î1 :: "state â value list â state â value list â bool" where
"Î1 s vl s1 vl1 â¡
 (â cid. PID ââ paperIDs s cid â¶ phase s cid < revPH) â§
 s = s1 â§ B vl vl1"

definition Î2 :: "state â value list â state â value list â bool" where
"Î2 s vl s1 vl1 â¡
 â cid.
    PID ââ paperIDs s cid â§ phase s cid = revPH â§ Â¬ (â uid. isREVNth s uid PID N) â§
    s = s1 â§ B vl vl1"

definition Î3 :: "state â value list â state â value list â bool" where
"Î3 s vl s1 vl1 â¡
 â cid uid.
    PID ââ paperIDs s cid â§ phase s cid = revPH â§ isREVNth s uid PID N â§
    eqExcPID_N s s1 â§ B vl vl1"

definition Î4 :: "state â value list â state â value list â bool" where
"Î4 s vl s1 vl1 â¡
 â cid uid.
    PID ââ paperIDs s cid â§ phase s cid â¥ revPH â§ isREVNth s uid PID N â§
    s = s1 â§ (â wl. vl = map (Pair disPH) wl â§ vl1 = map (Pair disPH) wl)"

definition Îe :: "state â value list â state â value list â bool" where
"Îe s vl s1 vl1 â¡
 vl â  [] â§
 (
  (â cid. PID ââ paperIDs s cid â§ phase s cid > revPH â§ Â¬ (â uid. isREVNth s uid PID N))
  â¨
  (â cid. PID ââ paperIDs s cid â§ phase s cid > revPH â§ fst (hd vl) = revPH)
 )"

lemma istate_Î1:
assumes B: "B vl vl1"
shows "Î1 istate vl istate vl1"
using B unfolding Î1_def B_def istate_def by auto

lemma unwind_cont_Î1: "unwind_cont Î1 {Î1,Î2,Îe}"
proof(rule, simp)
  let ?Î = "Î»s vl s1 vl1. Î1 s vl s1 vl1 â¨ Î2 s vl s1 vl1 â¨ Îe s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Î1 s vl s1 vl1"
  hence rs: "reach s" and ss1: "s1 = s" and B: "B vl vl1"
  and vl: "vl â  []" and vl1: "vl1 â  []" and PID_ph: "â cid. PID ââ paperIDs s cid â¶ phase s cid < revPH"
  using reachNT_reach unfolding Î1_def B_def by auto
  show "iaction ?Î s vl s1 vl1 â¨
        ((vl = [] â¶ vl1 = []) â§ reaction ?Î s vl s1 vl1)" (is "?iact â¨ (_ â§ ?react)")
  proof-
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"  let ?trn1 = "Trans s1 a ou s'"
      assume step: "step s a = (ou, s')" and T: "Â¬ T ?trn" and c: "consume ?trn vl vl'"
      have Ï: "Â¬ Ï ?trn"
        apply(cases a)
        subgoal by simp
        subgoal for x2 apply(cases x2) using step PID_ph by (fastforce simp: u_defs)+
        subgoal for x3 apply(cases x3) using step PID_ph by (fastforce simp: uu_defs)+
        by simp_all
      hence vl': "vl' = vl" using c unfolding consume_def by auto
      show "match ?Î s s1 vl1 a ou s' vl' â¨ ignore ?Î s s1 vl1 a ou s' vl'" (is "?match â¨ ?ignore")
      proof-
        have ?match proof
          show "validTrans ?trn1" unfolding ss1 using step by simp
        next
          show "consume ?trn1 vl1 vl1" unfolding consume_def ss1 using Ï by auto
        next
          show "Î³ ?trn = Î³ ?trn1" unfolding ss1 by simp
        next
          assume "Î³ ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
        next
          show "?Î s' vl' s' vl1"
          proof(cases "â cid. PID ââ paperIDs s cid")
            case False note PID = False
            have PID_ph': "â cid. PID ââ paperIDs s' cid â¹ phase s' cid < revPH" using PID step rs
            apply(cases a)
              subgoal for _ x1 apply(cases x1) apply(fastforce simp: c_defs)+ .
              subgoal for _ x2 apply(cases x2) apply(fastforce simp: u_defs)+ .
              subgoal for _ x3 apply(cases x3) apply(fastforce simp: uu_defs)+ .
              by auto
            hence "Î1 s' vl' s' vl1" unfolding Î1_def vl' using B PID_ph' vl by auto
            thus ?thesis by auto
          next
            case True
            then obtain CID where PID: "PID ââ paperIDs s CID" by auto
            hence ph: "phase s CID < revPH" using PID_ph by auto
            have PID': "PID ââ paperIDs s' CID" by (metis PID paperIDs_mono step)
            show ?thesis
            proof(cases "phase s' CID < revPH")
              case True note ph' = True
              hence "Î1 s' vl' s' vl1" unfolding Î1_def vl' using B vl ph' PID' apply auto
              by (metis reach_PairI paperIDs_equals rs step)
              thus ?thesis by auto
            next
              case False note ph' = False
              have "Â¬ (â uid. isRevNth s CID uid PID N)" using rs ph isRevNth_geq_revPH by fastforce
              hence ph_isRev': "phase s' CID = revPH â§ Â¬ (â uid. isRevNth s' CID uid PID N)"
              using ph' ph PID step rs
              apply(cases a)
                subgoal for x1 apply(cases x1) apply(fastforce simp: c_defs)+ .
                subgoal for x2 apply(cases x2) apply(fastforce simp: u_defs)+ .
                subgoal for x3 apply(cases x3) apply(fastforce simp: uu_defs)+ .
                by auto
              hence "Â¬ (â uid. isREVNth s' uid PID N)"
              by (metis PID' isREVNth_imp_isRevNth reach_PairI rs step)
              hence "Î2 s' vl' s' vl1" unfolding Î2_def vl' using B vl ph' PID' ph_isRev' by auto
              thus ?thesis by auto
            qed
          qed
        qed
        thus ?thesis by simp
      qed
    qed
    thus ?thesis using vl by auto
  qed
qed

lemma unwind_cont_Î2: "unwind_cont Î2 {Î2,Î3,Îe}"
proof(rule, simp)
  let ?Î = "Î»s vl s1 vl1. Î2 s vl s1 vl1 â¨ Î3 s vl s1 vl1 â¨ Îe s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Î2 s vl s1 vl1"
  then obtain CID where uuid: "Â¬ (â uid. isREVNth s uid PID N)" and PID: "PID ââ paperIDs s CID"
  and rs: "reach s" and ph: "phase s CID = revPH" (is "?ph = _") and ss1: "s1 = s"
  and B: "B vl vl1"
  and vl: "vl â  []" and vl1: "vl1 â  []"
  using reachNT_reach unfolding Î2_def B_def by auto
  hence uid: "Â¬ (â uid. isRevNth s CID uid PID N)" by (metis isREVNth_def)
  show "iaction ?Î s vl s1 vl1 â¨
        ((vl = [] â¶ vl1 = []) â§ reaction ?Î s vl s1 vl1)" (is "?iact â¨ (_ â§ ?react)")
  proof-
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"  let ?trn1 = "Trans s1 a ou s'"
      let ?ph' = "phase s' CID"
      assume step: "step s a = (ou, s')" and T: "Â¬ T ?trn" and c: "consume ?trn vl vl'"
      have Ï: "Â¬ Ï ?trn"
        apply(cases a)
        subgoal by simp
        subgoal for x2 apply(cases x2)
          using step ph apply (auto simp: u_defs)
          by (metis PID isRev_imp_isRevNth_getReviewIndex paperIDs_equals rs uid)
        subgoal for x3 apply(cases x3)
          using step ph apply (auto simp: uu_defs)
          using PID paperIDs_equals rs by force
        by simp_all
      hence vl': "vl' = vl" using c unfolding consume_def by auto
      have PID': "PID ââ paperIDs s' CID" by (metis paperIDs_mono step PID)
      show "match ?Î s s1 vl1 a ou s' vl' â¨ ignore ?Î s s1 vl1 a ou s' vl'" (is "?match â¨ ?ignore")
      proof-
        have ?match proof
          show "validTrans ?trn1" unfolding ss1 using step by simp
        next
          show "consume ?trn1 vl1 vl1" unfolding consume_def ss1 using Ï by auto
        next
          show "Î³ ?trn = Î³ ?trn1" unfolding ss1 by simp
        next
          assume "Î³ ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
        next
          show "?Î s' vl' s' vl1"
          proof(cases "?ph' = revPH")
            case True note ph' = True
            show ?thesis proof(cases "â uid. isRevNth s' CID uid PID N")
              case False
              hence "Â¬ (â uid. isREVNth s' uid PID N)"
              by (metis PID' isREVNth_def isRevNth_paperIDs paperIDs_equals reach_PairI rs1 ss1 step)
              hence "Î2 s' vl' s' vl1" unfolding Î2_def vl' using B ph' PID' unfolding B_def by auto
              thus ?thesis by auto
            next
              case True hence "â uid. isREVNth s' uid PID N" by (metis isREVNth_def)
              hence "Î3 s' vl' s' vl1" unfolding Î3_def vl' using B ph' PID' unfolding B_def by auto
              thus ?thesis by auto
            qed
          next
            case False
            hence ph': "?ph' > revPH" by (metis le_less step ph phase_increases)
            hence "Â¬ (â uid. isRevNth s' CID uid PID N)" using PID uid ph step rs
            apply(cases a)
              subgoal for x1 apply(cases x1) apply(fastforce simp: c_defs)+ .
              subgoal for x2 apply(cases x2) apply(fastforce simp: u_defs)+ .
              subgoal for x3 apply(cases x3) apply(fastforce simp: uu_defs)+ .
              by auto
            hence "Â¬ (â uid. isREVNth s' uid PID N)"
            by (metis IO_Automaton.reach_PairI PID' isREVNth_imp_isRevNth rs1 ss1 step)
            hence "Îe s' vl' s' vl1" using ph' vl PID' unfolding Îe_def vl' by auto
            thus ?thesis by auto
          qed
        qed
        thus ?thesis by simp
      qed
    qed
    thus ?thesis using vl by auto
  qed
qed

lemma unwind_cont_Î3: "unwind_cont Î3 {Î3,Î4,Îe}"
proof(rule, simp)
  let ?Î = "Î»s vl s1 vl1. Î3 s vl s1 vl1 â¨ Î4 s vl s1 vl1 â¨ Îe s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Î3 s vl s1 vl1"
  then obtain CID uid ul ul1 wl where uuid: "isREVNth s uid PID N"
  and rs: "reach s" and ph: "phase s CID = revPH" (is "?ph = _")  and ss1: "eqExcPID_N s s1"
  and PID: "PID ââ paperIDs s CID" and B: "B vl vl1"
  and vlvl1: "vl â  []" "vl1 â  []"
  and vl_wl: "vl = (map (Pair revPH) ul) @ (map (Pair disPH) wl)"
  and vl1_wl: "vl1 = (map (Pair revPH) ul1) @ (map (Pair disPH) wl)"
  and ulul1: "ul â  [] â§ ul1 â  [] â§ last ul = last ul1"
  using reachNT_reach unfolding Î3_def B_def by blast
  hence uid: "isRevNth s CID uid PID N" by (metis isREVNth_imp_isRevNth)
  have ph1: "phase s1 CID = revPH" using ss1 ph eqExcPID_N_imp by auto
  from ulul1 obtain u ul' u1 ul1' where ul: "ul = u # ul'" and ul1: "ul1 = u1 # ul1'" by (metis list.exhaust)
  obtain vl' vl1' where
  vl:  "vl = (revPH, u) # vl'"    and vl'_wl: "vl' = (map (Pair revPH) ul') @ (map (Pair disPH) wl)" and
  vl1: "vl1 = (revPH, u1) # vl1'" and vl1'_wl: "vl1' = (map (Pair revPH) ul1') @ (map (Pair disPH) wl)"
  unfolding vl_wl ul vl1_wl ul1 by auto
  have uid_notin: "uid â UIDs" using uid by (metis reachNT_non_isRevNth rsT)
  show "iaction ?Î s vl s1 vl1 â¨
        ((vl = [] â¶ vl1 = []) â§ reaction ?Î s vl s1 vl1)" (is "?iact â¨ (_ â§ ?react)")
  proof(cases "ul1' = []")
    case False note ul1' = False
    hence ul_ul1': "last ul = last ul1'" using ulul1 unfolding ul1 by simp
    have uid1: "isRevNth s1 CID uid PID N" using ss1 uid unfolding eqExcPID_N_def by auto
    define a1 where "a1 â¡ Uact (uReview CID uid (pass s uid) PID N u1)"
    obtain s1' ou1 where step1: "step s1 a1 = (ou1,s1')" by (metis prod.exhaust)
    let ?trn1 = "Trans s1 a1 ou1 s1'"
    have s1s1': "eqExcPID_N s1 s1'" using a1_def step1 by (metis uReview_uuReview_step_eqExcPID_N)
    have ss1': "eqExcPID_N s s1'" using eqExcPID_N_trans[OF ss1 s1s1'] .
    hence many_s1': "PID ââ paperIDs s1' CID" "isRevNth s1' CID uid PID N"
    "phase s1' CID = revPH" "pass s1' uid = pass s uid"
    using uid PID ph unfolding eqExcPID_N_def by auto
    hence more_s1': "uid ââ userIDs s1'" "CID ââ confIDs s1'"
    by (metis paperIDs_confIDs reach_PairI roles_userIDs rs1 step1 many_s1'(1))+
    have f: "f ?trn1 = (revPH,u1)" unfolding a1_def using ph1 by simp
    have rs1': "reach s1'" using rs1 step1 by (auto intro: reach_PairI)
    have ou1: "ou1 = outOK"
    using step1 uid1 ph unfolding a1_def apply (auto simp add: u_defs many_s1' more_s1')
    by (metis isRevNth_getReviewIndex isRev_def3 many_s1'(2) rs1')+
    have ?iact proof
      show "step s1 a1 = (ou1,s1')" by fact
    next
      show Ï: "Ï ?trn1" using ou1 unfolding a1_def by simp
      thus "consume ?trn1 vl1 vl1'" using f unfolding consume_def vl1 ul1 by simp
    next
      show "Â¬ Î³ ?trn1" by (simp add: a1_def uid_notin)
    next
      have "Î3 s vl s1' vl1'" unfolding Î3_def B_def
      using ph PID ss1' uuid ul1' vl_wl vl1'_wl ulul1 ul_ul1' by fastforce
      thus "?Î s vl s1' vl1'" by simp
    qed
    thus ?thesis by auto
  next
    case True hence ul1: "ul1 = [u1]" unfolding ul1 by simp
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vll'
      let ?trn = "Trans s a ou s'"
      let ?ph' = "phase s' CID"
      assume step: "step s a = (ou, s')" and T: "Â¬ T ?trn" and c: "consume ?trn vl vll'"
      have PID': "PID ââ paperIDs s' CID" using PID rs by (metis paperIDs_mono step)
      have uid': "isRevNth s' CID uid PID N" by (metis isRevNth_persistent rs step uid)
      hence uuid': "isREVNth s' uid PID N" by (metis isREVNth_def)
      show "match ?Î s s1 vl1 a ou s' vll' â¨ ignore ?Î s s1 vl1 a ou s' vll'" (is "?match â¨ ?ignore")
      proof(cases "Ï ?trn")
        case False note Ï = False
        have vll': "vll' = vl" using c Ï unfolding consume_def by auto
        obtain ou1 and s1' where step1: "step s1 a = (ou1,s1')" by (metis prod.exhaust)
        let ?trn1 = "Trans s1 a ou1 s1'"
        have s's1': "eqExcPID_N s' s1'" using eqExcPID_N_step[OF ss1 step step1] .
        have Ï1: "Â¬ Ï ?trn1" using Ï unfolding eqExcPID_N_step_Ï[OF ss1 step step1] .
        have ?match proof
          show "validTrans ?trn1" using step1 by simp
        next
          show "consume ?trn1 vl1 vl1" unfolding consume_def using Ï1 by auto
        next
          show "Î³ ?trn = Î³ ?trn1" unfolding ss1 by simp
        next
          assume "Î³ ?trn" thus "g ?trn = g ?trn1"
          using eqExcPID_N_step_out[OF ss1 step step1 rsT rs1 PID ph] by simp
        next
          show "?Î s' vll' s1' vl1"
          proof(cases "?ph' = revPH")
            case True
            hence "Î3 s' vll' s1' vl1"
            unfolding Î3_def B_def vll' using ph PID s's1' PID' uuid' vl_wl vl1_wl ulul1 by fastforce
            thus ?thesis by auto
          next
            case False hence "?ph' > revPH" using ph rs step by (metis le_less phase_increases2 snd_conv)
            hence "Îe s' vll' s1' vl1" using vlvl1 PID' unfolding Îe_def vll' vl_wl ul by auto
            thus ?thesis by auto
          qed
        qed
        thus ?thesis by simp
      next
        case True note Ï = True
        hence vll': "vll' = vl'" using c unfolding vl consume_def by simp
        obtain cid uid' p rc
        where "a = Uact (uReview cid uid' p PID N rc) â¨
               a = UUact (uuReview cid uid' p PID N rc)" and ou: "ou = outOK"
        using Ï c ph step ph unfolding vl consume_def Ï_def2 vll' by force
        hence a: "a = Uact (uReview cid uid' p PID N rc)"
        using step ph unfolding ou apply (auto simp: uu_defs) using PID paperIDs_equals rs by force
        have cid: "cid = CID"
          using step unfolding a
          apply(simp add: u_defs uu_defs)
           apply (metis PID e_updateReview_def isRev_paperIDs paperIDs_equals rs)
          by (metis ou out.distinct(1))
        hence Î³: "Â¬ Î³ ?trn" using step T rsT by (metis P_Ï_Î³ True)
        hence f: "f ?trn = (revPH,u)" using c Ï ph unfolding consume_def vl by simp
        have u: "u = rc" using f unfolding a by (auto simp: u_defs)
        have s's: "eqExcPID_N s' s" using eqExcPID_N_sym[OF Ï_step_eqExcPID_N[OF Ï step]] .
        have s's1: "eqExcPID_N s' s1" using eqExcPID_N_trans[OF s's ss1] .
        have ph': "phase s' CID = revPH" using s's ph unfolding eqExcPID_N_def by auto
        show ?thesis
        proof(cases "ul' = []")
          case False note ul' = False
          hence ul'ul1: "last ul' = last ul1" using ulul1 unfolding ul by auto
          have ?ignore proof
            show "Â¬ Î³ ?trn" by fact
          next
            show "?Î s' vll' s1 vl1"
            proof(cases "?ph' = revPH")
              case True
              hence "Î3 s' vll' s1 vl1"
                unfolding Î3_def B_def using ph PID s's1 PID'
                apply - apply(rule exI[of _ CID]) apply(rule exI[of _ uid])
                apply safe
                subgoal using uuid' by simp
                subgoal
                  apply(rule exI[of _ ul']) apply(rule exI[of _ ul1]) apply(rule exI[of _ wl])
                  unfolding vll' using vl'_wl vl1_wl ul'ul1 ul' ulul1 by auto
                done
              thus ?thesis by auto
            next
              case False hence "?ph' > revPH" using rs step ph' by blast
              hence "Îe s' vll' s1 vl1" unfolding Îe_def vll' vl'_wl using ul' PID' by (cases ul') auto
              thus ?thesis by auto
            qed
          qed
          thus ?thesis by auto
        next
          case True note ul' = True hence ul: "ul = [u]" unfolding ul by simp
(* the transition to Î4: Ï holds and both ul and ul1 (the parts of vl and vl1 that
cover the reviewing phase) are singletons: *)
          hence u1u: "u1 = u" using ulul1 unfolding ul1 by simp
          obtain s1' ou1 where step1: "step s1 a = (ou1,s1')" by (metis prod.exhaust)
          let ?trn1 = "Trans s1 a ou1 s1'"
          have Ï1: "Ï ?trn1" using eqExcPID_N_step_Ï_imp[OF ss1 step step1 Ï] .
          hence ou1: "ou1 = outOK" unfolding Ï_def2 by auto
          have "PID ââ paperIDs s1 CID" "â uid. isRevNth s1 CID uid PID N"
          using eqExcPID_N_imp[OF ss1] PID uid by auto
          hence many_s1': "revPH â¤ phase s1' CID" "PID ââ paperIDs s1' CID"
          "âuid. isRevNth s1' CID uid PID N"
          by (metis ph1 phase_increases step1 paperIDs_mono a
                    eqExcPID_N_step_eq ou rs ss1 step step1 uid')+
          hence uuid1': "âuid. isREVNth s1' uid PID N" by (metis isREVNth_def)
          have ?match proof
          show "validTrans ?trn1" using step1 by simp
        next
          show "consume ?trn1 vl1 (map (Pair disPH) wl)"
          using Ï1 ph1 unfolding consume_def by (simp add: a ul1 vl1_wl ul1 u1u u ph1 cid)
        next
          show "Î³ ?trn = Î³ ?trn1" unfolding ss1 by simp
        next
          assume "Î³ ?trn" thus "g ?trn = g ?trn1"
          using eqExcPID_N_step_out[OF ss1 step step1 rsT rs1 PID ph] by simp
        next
          note s's1' = eqExcPID_N_step_eq[OF rs ss1 a step[unfolded ou] step1]
          have "Î4 s' vll' s1' (map (Pair disPH) wl)"
          unfolding Î4_def B_def using ph PID s's1' many_s1' uuid1'
          unfolding vll' vl'_wl ul' by auto
          thus "?Î s' vll' s1' (map (Pair disPH) wl)" by simp
        qed
        thus ?thesis by simp
        qed
      qed
    qed
    thus ?thesis using vl by auto
  qed
qed

lemma unwind_cont_Î4: "unwind_cont Î4 {Î4,Îe}"
proof(rule, simp)
  let ?Î = "Î»s vl s1 vl1. Î4 s vl s1 vl1 â¨ Îe s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Î4 s vl s1 vl1"
  then obtain uid CID  wl where uuid: "isREVNth s uid PID N"
  and rs: "reach s" and ph: "phase s CID â¥ revPH" (is "?ph â¥ revPH") and ss1: "s1 = s"
  and PID: "PID ââ paperIDs s CID" and vl: "vl = map (Pair disPH) wl"
  and vl1: "vl1 = map (Pair disPH) wl"
  using reachNT_reach unfolding Î4_def by blast
  hence uid: "isRevNth s CID uid PID N" by (metis isREVNth_imp_isRevNth)
  show "iaction ?Î s vl s1 vl1 â¨
        ((vl = [] â¶ vl1 = []) â§ reaction ?Î s vl s1 vl1)" (is "?iact â¨ (_ â§ ?react)")
  proof-
    have "?react"
    proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      let ?ph' = "phase s' CID"
      assume step: "step s a = (ou, s')" and T: "Â¬ T ?trn" and c: "consume ?trn vl vl'"
      have uid': "isRevNth s' CID uid PID N" by (metis isRevNth_persistent rs step uid)
      hence uuid': "isREVNth s' uid PID N" by (metis isREVNth_def)
      have PID': "PID ââ paperIDs s' CID" using PID rs by (metis paperIDs_mono step)
      have ph': "phase s' CID â¥ revPH" using rs isRevNth_geq_revPH local.step reach_PairI uid' by blast
      let ?trn1 = "Trans s1 a ou s'"
      show "match ?Î s s1 vl1 a ou s' vl' â¨ ignore ?Î s s1 vl1 a ou s' vl'" (is "?match â¨ ?ignore")
      proof(cases "Ï ?trn")
        case True note Ï = True
        hence Ï1: "Ï ?trn1" unfolding ss1 by simp
        obtain w wl' where wl: "wl = w # wl'" and vl: "vl = (disPH,w) # map (Pair disPH) wl'"
        and vl1: "vl1 = (disPH,w) # map (Pair disPH) wl'" and vl': "vl' = map (Pair disPH) wl'"
        using Ï Ï1 c unfolding vl vl1 consume_def by (cases wl) auto
        have f: "f ?trn = (disPH, w)" "f ?trn1 = (disPH, w)"
        using Ï Ï1 c unfolding consume_def vl vl1 ss1 by auto
        have ?match proof
          show "validTrans ?trn1" using step unfolding ss1 by simp
        next
          show "consume ?trn1 vl1 vl'" unfolding consume_def vl1 vl' using Ï1 f by auto
        next
          show "Î³ ?trn = Î³ ?trn1" unfolding ss1 by simp
        next
          assume "Î³ ?trn" thus "g ?trn = g ?trn1" by simp
        next
          have "Î4 s' vl' s' vl'"
          using ph' PID' uuid' unfolding Î4_def vl' by auto
          thus "?Î s' vl' s' vl'" by simp
        qed
        thus ?thesis by simp
      next
        case False note Ï = False
        hence Ï1: "Â¬ Ï ?trn1" unfolding ss1 by simp
        hence vl': "vl' = vl" using Ï c unfolding vl consume_def by auto
        have ?match proof
          show "validTrans ?trn1" using step unfolding ss1 by simp
        next
          show "consume ?trn1 vl1 vl" unfolding consume_def vl1 vl using Ï1 by auto
        next
          show "Î³ ?trn = Î³ ?trn1" unfolding ss1 by simp
        next
          assume "Î³ ?trn" thus "g ?trn = g ?trn1" by simp
        next
          have "Î4 s' vl' s' vl"
          using ph' PID' uuid' unfolding Î4_def vl' vl by auto
          thus "?Î s' vl' s' vl" by simp
        qed
        thus ?thesis by simp
      qed
    qed
    thus ?thesis using vl vl1 by simp
  qed
qed

(* Exit arguments: *)
definition K2exit where
"K2exit cid s â¡
 PID ââ paperIDs s cid â§ phase s cid > revPH â§ Â¬ (â uid. isRevNth s cid uid PID N)"

lemma invarNT_K2exit: "invarNT (K2exit cid)"
unfolding invarNT_def apply (safe dest!: reachNT_reach)
  subgoal for _ a apply(cases a)
    subgoal for x1 apply(cases x1) apply (fastforce simp add: c_defs K2exit_def geq_noPH_confIDs)+ .
    subgoal for x2 apply(cases x2) apply (fastforce simp add: u_defs K2exit_def paperIDs_equals)+ .
    subgoal for x3 apply(cases x3) apply (fastforce simp add: uu_defs K2exit_def)+ .
    by auto
  done

lemma noVal_K2exit: "noVal (K2exit cid) v"
apply(rule noÏ_noVal)
unfolding noÏ_def apply safe
  subgoal for _ a apply(cases a)
    subgoal by (fastforce simp add: c_defs K2exit_def)
    subgoal for x2 apply(cases x2) apply (auto simp add: u_defs K2exit_def)
     apply (metis less_not_refl paperIDs_equals reachNT_reach) .
    subgoal for x3 apply(cases x3) apply (auto simp add: uu_defs K2exit_def)
      apply (metis isRev_def3 paperIDs_equals reachNT_reach) .
    by auto
  done

definition K3exit where
"K3exit cid s â¡ PID ââ paperIDs s cid â§ phase s cid > revPH"

lemma invarNT_K3exit: "invarNT (K3exit cid)"
unfolding invarNT_def apply (safe dest!: reachNT_reach)
  subgoal for _ a apply(cases a)
    subgoal for x1 apply(cases x1) apply (fastforce simp add: c_defs K3exit_def geq_noPH_confIDs)+ .
    subgoal for x2 apply(cases x2) apply (fastforce simp add: u_defs K3exit_def paperIDs_equals)+ .
    subgoal for x3 apply(cases x3) apply (fastforce simp add: uu_defs K3exit_def)+ .
    by auto
  done

(* The most interesting exit condition so far, not reducible to the "noÏ" condition *)
lemma noVal_K3exit: "noVal (K3exit cid) (revPH,u)"
unfolding noVal_def apply safe
  subgoal for _ a apply(cases a)
    subgoal by (fastforce simp add: c_defs K3exit_def)
    subgoal for x2 apply(cases x2) apply (auto simp add: u_defs K3exit_def)
     apply (metis less_not_refl paperIDs_equals reachNT_reach) .
    subgoal for x3 apply(cases x3) apply (auto simp add: uu_defs K3exit_def) .
    by auto
  done

lemma unwind_exit_Îe: "unwind_exit Îe"
proof
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and Îe: "Îe s vl s1 vl1"
  hence rs:  "reach s" and vl: "vl â  []" using reachNT_reach unfolding Îe_def by auto
  then obtain CID where K: "K2exit CID s â¨ K3exit CID s" and PID: "PID ââ paperIDs s CID"
  using Îe unfolding K2exit_def K3exit_def Îe_def by auto
  show "vl â  [] â§ exit s (hd vl)" proof(simp add: vl, cases "K2exit CID s")
    case True
    thus "exit s (hd vl)"
    by (metis rsT exitI2 invarNT_K2exit noVal_K2exit)
  next
    case False
    then obtain u where h: "hd vl = (revPH,u)" and K3: "K3exit CID s"
    using Îe K PID rs unfolding Îe_def K2exit_def K3exit_def
    by (cases vl) (auto simp: isREVNth_def)
    show "exit s (hd vl)" unfolding h using K3
    by (metis rsT exitI2 invarNT_K3exit noVal_K3exit)
  qed
qed

theorem secure: secure
apply(rule unwind_decomp4_secure[of Î1 Î2 Îe Î3 Î4])
using
istate_Î1
unwind_cont_Î1 unwind_cont_Î2 unwind_cont_Î2 unwind_cont_Î3 unwind_cont_Î4
unwind_exit_Îe
by auto


end

Theory Review_RAut_NCPC

theory Review_RAut_NCPC
imports "../Observation_Setup" Review_Value_Setup "Bounded_Deducibility_Security.Compositional_Reasoning"
begin

subsection â¹Confidentiality protection from users who are not the review's author or a PC memberâº

text â¹We verify the following property:

\ \\
A group of users UIDs learn nothing
about the various updates of the N'th review of a paper PID
except for the last edited version before notification
unless/until one of the following holds:
\begin{itemize}
\item a user in UIDs is the review's author, or
\item a user in UIDs becomes a PC member in the paper's conference
having no conflict with that paper, and the conference moves to the discussion phase.
\end{itemize}
âº

type_synonym "value" = rcontent

fun f :: "(state,act,out) trans â value" where
"f (Trans _ (Uact (uReview cid uid p pid n rc)) _ _) = rc"
|
"f (Trans _ (UUact (uuReview cid uid p pid n rc)) _ _) = rc"

fun T :: "(state,act,out) trans â bool" where
"T (Trans _ _ ou s') =
 (â uid â UIDs.
    isREVNth s' uid PID N
    â¨
    (â cid. PID ââ paperIDs s' cid â§ isPC s' cid uid â§ pref s' uid PID â  Conflict â§ phase s' cid â¥ disPH)
 )"

declare T.simps [simp del]

definition B :: "value list â value list â bool" where
"B vl vl1 â¡ vl â  [] â§ vl1 â  [] â§ last vl = last vl1"

interpretation BD_Security_IO where
istate = istate and step = step and
Ï = Ï and f = f and Î³ = Î³ and g = g and T = T and B = B
done

lemma reachNT_non_isRevNth_isPC_isChair:
assumes "reachNT s" and "uid â UIDs"
shows
"Â¬ isRevNth s cid uid PID N â§
 (PID ââ paperIDs s cid â§ isPC s cid uid â¶ pref s uid PID = Conflict â¨ phase s cid < disPH) â§
 (PID ââ paperIDs s cid â§ isChair s cid uid â¶ pref s uid PID = Conflict â¨ phase s cid < disPH)"
  using assms
  apply induct
   apply (auto simp: istate_def)[]
  apply(intro conjI)
  subgoal for trn apply(cases trn, auto simp: T.simps reachNT_reach isREVNth_def)[] .
  subgoal by (metis T.elims(3) not_le_imp_less tgtOf_simps)
  by (metis T.elims(3) isChair_isPC not_le_imp_less reach.Step reachNT_reach tgtOf_simps)

(* important: *) lemma T_Ï_Î³:
assumes 1: "reachNT s" and 2: "step s a = (ou,s')" "Ï (Trans s a ou s')"
shows "Â¬ Î³ (Trans s a ou s')"
using reachNT_non_isRevNth_isPC_isChair[OF 1] 2 unfolding T.simps Ï_def2
apply (auto simp add: u_defs uu_defs) by (metis isRev_imp_isRevNth_getReviewIndex)+

(* major *) lemma eqExcPID_N_step_out:
assumes s's1': "eqExcPID_N s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and sP: "reachNT s" and s1: "reach s1"
and PID: "PID ââ paperIDs s cid"
and ph: "phase s cid = revPH â¨ phase s cid = disPH"
and UIDs: "userOfA a â UIDs"
shows "ou = ou1"
proof-
  note Inv = reachNT_non_isRevNth_isPC_isChair[OF sP UIDs]
  note eqs = eqExcPID_N_imp[OF s's1']
  note eqs' = eqExcPID_N_imp1[OF s's1']
  note eqss = eqExcPID_N_imp2[OF s's1']
  note s = reachNT_reach[OF sP]

  note simps[simp] = c_defs u_defs uu_defs r_defs l_defs Paper_dest_conv eqExcPID_N_def eeqExcPID_N_def eqExcD
  note * = step step1 eqs eqs' s s1 PID UIDs ph paperIDs_equals[OF s] Inv

  show ?thesis
  proof (cases a)
    case (Cact x1)
    with * show ?thesis by (cases x1; auto)
  next
    case (Uact x2)
    with * show ?thesis by (cases x2; auto)
  next
    case (UUact x3)
    with * show ?thesis by (cases x3; auto)
  next
    case (Ract x4)
    with * show ?thesis
    proof (cases x4)
      case (rMyReview x81 x82 x83 x84)
      with Ract * show ?thesis
        by clarsimp (metis eqExcPID_N_imp3' getRevRole_Some_Rev_isRevNth s's1')
    next
      case (rReviews x91 x92 x93 x94)
      with Ract * show ?thesis
        by clarsimp (metis eqss not_less)
    next
      case (rFinalReviews x121 x122 x123 x124)
      with Ract * show ?thesis
        by clarsimp (metis Suc_leD Suc_n_not_le_n)
    qed auto
  next
    case (Lact x5)
    with * show ?thesis by (cases x5; auto; presburger)
  qed
qed

(* major *) lemma eqExcPID_N2_step_out:
assumes ss1: "eqExcPID_N2 s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and sP: "reachNT s" and s1: "reach s1"
and r: "isRevNth s cid uid PID N"
and ph: "phase s cid â¥ revPH"
and UIDs: "userOfA a â UIDs"
and decs_exit: "(reviewsPaper (paper s PID))!N â  [] â§ (reviewsPaper (paper s1 PID))!N â  []"
shows "ou = ou1"
proof-
  note s = reachNT_reach[OF sP]
  note Inv = reachNT_non_isRevNth_isPC_isChair[OF sP UIDs]
  note eqs = eqExcPID_N2_imp[OF ss1]
  note eqs' = eqExcPID_N2_imp1[OF ss1]
  note eqss = eqExcPID_N2_imp2[OF ss1] eqExcPID_N2_imp3'[OF s ss1] eqExcPID_N2_imp33[OF ss1]

  have PID: "PID ââ paperIDs s cid" using r by (metis isRevNth_paperIDs s)
  have PID1: "PID ââ paperIDs s1 cid" using PID ss1 unfolding eqExcPID_N2_def by auto
  have r1: "isRevNth s1 cid uid PID N" by (metis eqs r)
  hence decs_exit': "(reviewsPaper (paper s' PID))!N â  [] â§
                     (reviewsPaper (paper s1' PID))!N â  []"
  using nonempty_reviews_persist s s1 PID PID1 r r1 decs_exit step step1 by metis+

  note simps[simp] = c_defs u_defs uu_defs r_defs l_defs Paper_dest_conv eqExcPID_N2_def eeqExcPID_N2_def eqExcD2

  have "eqExcD2 (paper s PID) (paper s1 PID)"
  using eqExcPID_N2_imp[OF ss1] eeqExcPID_N2_imp by blast
  hence 1: "hd (reviewsPaper (paper s PID) ! N) =
            hd (reviewsPaper (paper s1 PID) ! N)"
  unfolding eqExcD2 eqExcNth2_def by auto

  { fix cid uid p pid assume a: "a = Ract (rFinalReviews cid uid p pid)"
    have ?thesis using step step1 eqExcPID_N2_imp[OF ss1]
      unfolding a
      apply clarsimp
      apply(intro nth_equalityI)
      subgoal by simp
      subgoal for i apply (cases "i â  N")
        subgoal by simp (smt eqExcPID_N2_imp3 getNthReview_def ss1)
        by (auto split: list.splits)
      subgoal for i ia
        apply (cases "pid = PID")
        subgoal
          apply(cases "reviewsPaper (paper s' PID) ! i")
          subgoal apply simp
            by (smt decs_exit eqExcPID_N2_imp3 getNthReview_def list.simps(4) nth_Cons_0 ss1)
          subgoal apply(cases "reviewsPaper (paper s1' PID) ! i ")
            subgoal apply simp
              by (metis (no_types, lifting) decs_exit eqExcD2 eqExcNth2_def neq_Nil_conv)
            subgoal apply simp
              by (metis (no_types, lifting) eqExcD2 eqExcNth2_def list.sel(1)) . .
        subgoal by simp . .
  } note this[simp]

  note * = step step1 eqs eqs' s s1 PID PID1 r r1 UIDs ph paperIDs_equals[OF s] Inv

  show ?thesis
  proof (cases a)
    case (Cact x1)
    with * show ?thesis by (cases x1; auto)
  next
    case (Uact x2)
    with * show ?thesis by (cases x2; auto)
  next
    case (UUact x3)
    with * show ?thesis by (cases x3; auto)
  next
    case (Ract x4)
    with * show ?thesis
    proof (cases x4)
      case (rMyReview x81 x82 x83 x84)
      with Ract * show ?thesis
        by clarsimp (metis eqss(2) getRevRole_Some_Rev_isRevNth)
    next
      case (rReviews x91 x92 x93 x94)
      with Ract * show ?thesis
        by clarsimp (metis eqss(1) not_less)
    qed auto
  next
    case (Lact x5)
    with * show ?thesis by (cases x5; auto; presburger)
  qed
qed

lemma eqExcPID_N_step_eqExcPID_N2:
assumes rs: "reach s"
and a: "a = Uact (uReview cid uid p PID N rc) â¨
        a = UUact (uuReview cid uid p PID N rc)" (is "?L â¨ ?R")
and ss1: "eqExcPID_N s s1"
and step: "step s a = (outOK,s')" and step1: "step s1 a = (outOK,s1')"
shows "eqExcPID_N2 s' s1'"
using a proof
  assume a: ?L
  have "isRevNth s cid uid PID N" using step unfolding a apply(simp add: u_defs uu_defs)
  by (metis isRev_imp_isRevNth_getReviewIndex)
  hence N: "N < length (reviewsPaper (paper s PID))"
  using rs by (metis isRevNth_less_length)
  hence N1: "N < length (reviewsPaper (paper s1 PID))"
  using ss1 unfolding eqExcPID_N_def eeqExcPID_N_def eqExcD eqExcNth_def by auto
  have "eqExcPID_N s' s1'" using assms by (metis eqExcPID_N_step)
  moreover have "hd (reviewsPaper (paper s' PID) ! N) = hd (reviewsPaper (paper s1' PID) ! N)"
  using step step1 N N1 unfolding a by(auto simp add: u_defs uu_defs)
  ultimately show ?thesis
  unfolding eqExcPID_N_def eqExcPID_N2_def eeqExcPID_N_def eeqExcPID_N2_def eqExcD2 eqExcD
  eqExcNth_def eqExcNth2_def by auto
next
  assume a: ?R
  have "isRevNth s cid uid PID N" using step unfolding a apply(simp add: u_defs uu_defs)
  by (metis isRev_imp_isRevNth_getReviewIndex)
  hence N: "N < length (reviewsPaper (paper s PID))"
  using rs by (metis isRevNth_less_length)
  hence N1: "N < length (reviewsPaper (paper s1 PID))"
  using ss1 unfolding eqExcPID_N_def eeqExcPID_N_def eqExcD eqExcNth_def by auto
  have "eqExcPID_N s' s1'" using assms by (metis eqExcPID_N_step)
  moreover have "hd (reviewsPaper (paper s' PID) ! N) = hd (reviewsPaper (paper s1' PID) ! N)"
  using step step1 N N1 unfolding a by(auto simp add: u_defs uu_defs)
  ultimately show ?thesis
  unfolding eqExcPID_N_def eqExcPID_N2_def eeqExcPID_N_def eeqExcPID_N2_def eqExcD2 eqExcD
  eqExcNth_def eqExcNth2_def by auto
qed

(* major *) lemma eqExcPID_N_step_Ï_eqExcPID_N2:
assumes rs: "reach s"
and ss1: "eqExcPID_N s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and Ï: "Ï (Trans s a ou s')"
shows "eqExcPID_N2 s' s1'"
proof-
  obtain cid uid p rc where
  a: "a = Uact (uReview cid uid p PID N rc) â¨
      a = UUact (uuReview cid uid p PID N rc)" (is "?L â¨ ?R")
  and ou: "ou = outOK"
  using Ï unfolding Ï_def2 by blast
  have Ï1: "Ï (Trans s1 a ou1 s1')" using Ï ss1 by (metis eqExcPID_N_step_Ï_imp step step1)
  hence ou1: "ou1 = outOK" using Ï unfolding Ï_def2 by auto
  show ?thesis using eqExcPID_N_step_eqExcPID_N2[OF rs a ss1 step[unfolded ou] step1[unfolded ou1]] .
qed

definition Î1 :: "state â value list â state â value list â bool" where
"Î1 s vl s1 vl1 â¡
 (â cid. PID ââ paperIDs s cid â¶ phase s cid < revPH)  â§
 s = s1 â§ B vl vl1"

definition Î2 :: "state â value list â state â value list â bool" where
"Î2 s vl s1 vl1 â¡
 â cid.
    PID ââ paperIDs s cid â§ phase s cid = revPH â§ Â¬ (â uid. isREVNth s uid PID N) â§
    s = s1 â§ B vl vl1"

definition Î3 :: "state â value list â state â value list â bool" where
"Î3 s vl s1 vl1 â¡
 â cid uid.
    PID ââ paperIDs s cid â§ phase s cid â {revPH, disPH} â§ isREVNth s uid PID N â§
    eqExcPID_N s s1 â§ B vl vl1"

definition Î4 :: "state â value list â state â value list â bool" where
"Î4 s vl s1 vl1 â¡
 â cid uid.
    PID ââ paperIDs s cid â§ phase s cid â¥ revPH â§ isREVNth s uid PID N â§
    (reviewsPaper (paper s PID))!N â  [] â§ (reviewsPaper (paper s1 PID))!N â  [] â§
    eqExcPID_N2 s s1 â§ vl = [] â§ vl1 = []"

definition Îe :: "state â value list â state â value list â bool" where
"Îe s vl s1 vl1 â¡
 vl â  [] â§
 (
  (â cid. PID ââ paperIDs s cid â§ phase s cid > revPH â§ Â¬ (â uid. isREVNth s uid PID N))
  â¨
  (â cid. PID ââ paperIDs s cid â§ phase s cid > disPH)
 )"

lemma istate_Î1:
assumes B: "B vl vl1"
shows "Î1 istate vl istate vl1"
using B unfolding Î1_def B_def istate_def by auto

lemma unwind_cont_Î1: "unwind_cont Î1 {Î1,Î2,Îe}"
proof(rule, simp)
  let ?Î = "Î»s vl s1 vl1. Î1 s vl s1 vl1 â¨ Î2 s vl s1 vl1 â¨ Îe s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsP: "reachNT s" and rs1: "reach s1" and "Î1 s vl s1 vl1"
  hence rs: "reach s" and ss1: "s1 = s"
  and vl: "vl â  []" and vl1: "vl1 â  []" and vl_vl1: "last vl1 = last vl"
  and PID_ph: "â cid. PID ââ paperIDs s cid â¹ phase s cid < revPH"
  using reachNT_reach unfolding Î1_def B_def by auto
  note vlvl1 = vl vl1 vl_vl1
  show "iaction ?Î s vl s1 vl1 â¨
        ((vl = [] â¶ vl1 = []) â§ reaction ?Î s vl s1 vl1)" (is "?iact â¨ (_ â§ ?react)")
  proof-
    have ?react proof
      fix a :: act and ou :: out and s' and vl'
      let ?trn = "Trans s a ou s'"  let ?trn1 = "Trans s1 a ou s'"
      assume step: "step s a = (ou, s')" and P: "Â¬ T ?trn" and c: "consume ?trn vl vl'"
      have Ï: "Â¬ Ï ?trn"
        apply(cases a)
        subgoal by simp
        subgoal for x2 apply(cases x2) using step PID_ph by (fastforce simp: u_defs)+
        subgoal for x3 apply(cases x3) using step PID_ph by (fastforce simp: uu_defs)+
        by simp_all
      hence vl': "vl' = vl" using c unfolding consume_def by auto
      show "match ?Î s s1 vl1 a ou s' vl' â¨ ignore ?Î s s1 vl1 a ou s' vl'" (is "?match â¨ ?ignore")
      proof-
        have ?match proof
          show "validTrans ?trn1" unfolding ss1 using step by simp
        next
          show "consume ?trn1 vl1 vl1" unfolding consume_def ss1 using Ï by auto
        next
          show "Î³ ?trn = Î³ ?trn1" unfolding ss1 by simp
        next
          assume "Î³ ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
        next
          show "?Î s' vl' s' vl1"
          proof(cases "â cid. PID ââ paperIDs s cid")
            case False note PID = False
            have PID_ph': "â cid. PID ââ paperIDs s' cid â¹ phase s' cid < revPH" using PID step rs
            subgoal apply(cases a)
              subgoal for x1 apply(cases x1) apply(fastforce simp: c_defs)+ .
              subgoal for x2 apply(cases x2) apply(fastforce simp: u_defs)+ .
              subgoal for x3 apply(cases x3) apply(fastforce simp: uu_defs)+ .
              by auto
            done
            hence "Î1 s' vl' s' vl1" unfolding Î1_def B_def B_def vl' using PID_ph' vlvl1 by auto
            thus ?thesis by auto
          next
            case True
            then obtain CID where PID: "PID ââ paperIDs s CID" by auto
            hence ph: "phase s CID < revPH" using PID_ph by auto
            have PID': "PID ââ paperIDs s' CID" by (metis PID paperIDs_mono step)
            show ?thesis
            proof(cases "phase s' CID < revPH")
              case True note ph' = True
              hence "Î1 s' vl' s' vl1" unfolding Î1_def B_def B_def vl' using vlvl1 ph' PID' apply auto
              by (metis reach_PairI paperIDs_equals rs step)
              thus ?thesis by auto
            next
              case False note ph' = False
              have "Â¬ (â uid. isRevNth s CID uid PID N)" using rs ph isRevNth_geq_revPH by fastforce
              hence ph_isRev': "phase s' CID = revPH â§ Â¬ (â uid. isRevNth s' CID uid PID N)"
              using ph' ph PID step rs
              subgoal apply(cases a)
                subgoal for x1 apply(cases x1) apply(fastforce simp: c_defs)+ .
                subgoal for x2 apply(cases x2) apply(fastforce simp: u_defs)+ .
                subgoal for x3 apply(cases x3) apply(fastforce simp: uu_defs)+ .
                by auto
              done
              hence "Â¬ (â uid. isREVNth s' uid PID N)"
              by (metis PID' isREVNth_imp_isRevNth reach_PairI rs step)
              hence "Î2 s' vl' s' vl1" unfolding Î2_def B_def vl' using vlvl1 ph' PID' ph_isRev' by auto
              thus ?thesis by auto
            qed
          qed
        qed
        thus ?thesis by simp
      qed
    qed
    thus ?thesis using vl by auto
  qed
qed

lemma unwind_cont_Î2: "unwind_cont Î2 {Î2,Î3,Îe}"
proof(rule, simp)
  let ?Î = "Î»s vl s1 vl1. Î2 s vl s1 vl1 â¨ Î3 s vl s1 vl1 â¨ Îe s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsP: "reachNT s" and rs1: "reach s1" and "Î2 s vl s1 vl1"
  then obtain CID where rs: "reach s" and ph: "phase s CID = revPH" (is "?ph = _") and ss1: "s1 = s"
  and uuid: "Â¬ (â uid. isREVNth s uid PID N)"
  and vl: "vl â  []" and vl1: "vl1 â  []" and vl_vl1: "last vl1 = last vl"
  and PID: "PID ââ paperIDs s CID" using reachNT_reach unfolding Î2_def B_def by auto
  hence uid: "Â¬ (â uid. isRevNth s CID uid PID N)" by (metis isREVNth_def)
  note vlvl1 = vl vl1 vl_vl1
  show "iaction ?Î s vl s1 vl1 â¨
        ((vl = [] â¶ vl1 = []) â§ reaction ?Î s vl s1 vl1)" (is "?iact â¨ (_ â§ ?react)")
  proof-
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"  let ?trn1 = "Trans s1 a ou s'"
      let ?ph' = "phase s' CID"
      assume step: "step s a = (ou, s')" and P: "Â¬ T ?trn" and c: "consume ?trn vl vl'"
      have Ï: "Â¬ Ï ?trn"
        apply(cases a)
        subgoal by simp
        subgoal for x2 apply(cases x2)
          using step ph apply (auto simp: u_defs)
          by (metis PID isRev_imp_isRevNth_getReviewIndex paperIDs_equals rs uid)
        subgoal for x3 apply(cases x3)
          using step ph apply (auto simp: uu_defs)
          using PID paperIDs_equals rs by force
        by simp_all
      hence vl': "vl' = vl" using c unfolding consume_def by auto
      have PID': "PID ââ paperIDs s' CID" by (metis paperIDs_mono step PID)
      show "match ?Î s s1 vl1 a ou s' vl' â¨ ignore ?Î s s1 vl1 a ou s' vl'" (is "?match â¨ ?ignore")
      proof-
        have ?match proof
          show "validTrans ?trn1" unfolding ss1 using step by simp
        next
          show "consume ?trn1 vl1 vl1" unfolding consume_def ss1 using Ï by auto
        next
          show "Î³ ?trn = Î³ ?trn1" unfolding ss1 by simp
        next
          assume "Î³ ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
        next
          show "?Î s' vl' s' vl1"
          proof(cases "?ph' = revPH")
            case False
            hence 1: "?ph' > revPH â§ Â¬ (â uid. isRevNth s' CID uid PID N)"
            using uid PID ph step rs
            subgoal apply(cases a)
              subgoal for x1 apply(cases x1) apply(fastforce simp: c_defs)+ .
              subgoal for x2 apply(cases x2) apply(fastforce simp: u_defs)+ .
              subgoal for x3 apply(cases x3) apply(fastforce simp: uu_defs)+ .
              by auto
            done
            hence "Â¬ (â uid. isREVNth s' uid PID N)"
            by (metis PID' isREVNth_imp_isRevNth reach_PairI rs step)
            hence "Îe s' vl' s' vl1" unfolding Îe_def vl' using PID' vl 1 by auto
            thus ?thesis by simp
          next
            case True note ph' = True
            show ?thesis proof(cases "â uid. isREVNth s' uid PID N")
              case False
              hence "Î2 s' vl' s' vl1" using PID' vlvl1 ph' unfolding Î2_def B_def vl' by auto
              thus ?thesis by simp
            next
              case True
              hence "Î3 s' vl' s' vl1" using PID' vlvl1 ph' unfolding Î3_def B_def vl' by auto
              thus ?thesis by simp
            qed
          qed
        qed
        thus ?thesis by simp
      qed
    qed
    thus ?thesis using vl by auto
  qed
qed

lemma unwind_cont_Î3: "unwind_cont Î3 {Î3,Î4,Îe}"
proof(rule, simp)
  let ?Î = "Î»s vl s1 vl1. Î3 s vl s1 vl1 â¨ Î4 s vl s1 vl1 â¨ Îe s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Î3 s vl s1 vl1"
  then obtain CID uid where uuid: "isREVNth s uid PID N"
  and PID: "PID ââ paperIDs s CID"
  and rs: "reach s" and ph: "phase s CID = revPH â¨ phase s CID = disPH" (is "?ph = _ â¨ _")
  and ss1: "eqExcPID_N s s1" and vl: "vl â  []" and vl1: "vl1 â  []" and vl_vl1: "last vl = last vl1"
  using reachNT_reach unfolding Î3_def B_def by auto
  hence uid: "isRevNth s CID uid PID N" by (metis isREVNth_imp_isRevNth)
  note vlvl1 = vl vl1 vl_vl1
  from vl vl1 obtain v vl' v1 vl1' where vl: "vl = v # vl'" and vl1: "vl1 = v1 # vl1'" by (metis list.exhaust)
  have uid_notin: "uid â UIDs" using uid by (metis reachNT_non_isRevNth_isPC_isChair rsT)
  show "iaction ?Î s vl s1 vl1 â¨
        ((vl = [] â¶ vl1 = []) â§ reaction ?Î s vl s1 vl1)" (is "?iact â¨ (_ â§ ?react)")
  proof(cases "vl1' = []")
    case False note vl1' = False
    hence vl_vl1': "last vl = last vl1'" using vl_vl1 unfolding vl1 by simp
    have uid1: "isRevNth s CID uid PID N" using ss1 uid unfolding eqExcPID_N_def by auto
    define a1 where "a1 â¡
     if ?ph = revPH
      then Uact (uReview CID uid (pass s uid) PID N v1)
      else UUact (uuReview CID uid (pass s uid) PID N v1)"
    (is "_ â¡ if ?ph = revPH then ?A else ?B")
    hence a1: "a1 â {?A,?B}" by auto
    obtain s1' ou1 where step1: "step s1 a1 = (ou1,s1')" by (metis prod.exhaust)
    let ?trn1 = "Trans s1 a1 ou1 s1'"
    have s1s1': "eqExcPID_N s1 s1'" using step1 by (metis a1_def uReview_uuReview_step_eqExcPID_N)
    have ss1': "eqExcPID_N s s1'" using eqExcPID_N_trans[OF ss1 s1s1'] .
    hence many_s1': "PID ââ paperIDs s1' CID" "isRevNth s1' CID uid PID N"
    "pass s1' uid = pass s uid" "phase s1' CID = phase s CID"
    using uid PID ph unfolding eqExcPID_N_def by simp_all
    hence more_s1': "uid ââ userIDs s1'" "CID ââ confIDs s1'"
    by (metis paperIDs_confIDs reach_PairI roles_userIDs rs1 step1 many_s1'(1))+
    have f: "f ?trn1 = v1" unfolding a1_def by simp
    have rs1': "reach s1'" using rs1 step1 by (auto intro: reach_PairI)
    have ou1: "ou1 = outOK"
    using step1 uid1 ph unfolding a1_def apply (simp_all add: u_defs uu_defs many_s1' more_s1')
    by (metis isRevNth_getReviewIndex isRev_def3 many_s1' rs1')+
    have ?iact proof
      show "step s1 a1 = (ou1,s1')" by fact
    next
      show Ï: "Ï ?trn1" using ou1 unfolding a1_def by simp
      thus "consume ?trn1 vl1 vl1'" using f unfolding consume_def vl1 by simp
    next
      show "Â¬ Î³ ?trn1" by (simp add: a1_def uid_notin)
    next
      have "Î3 s vl s1' vl1'" unfolding Î3_def B_def using ph PID ss1' uuid vl_vl1' vl1' vl by auto
      thus "?Î s vl s1' vl1'" by simp
    qed
    thus ?thesis by auto
  next
    case True hence vl1: "vl1 = [v1]" unfolding vl1 by simp
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vll'
      let ?trn = "Trans s a ou s'"
      let ?ph' = "phase s' CID"
      assume step: "step s a = (ou, s')" and T: "Â¬ T ?trn" and c: "consume ?trn vl vll'"
      have PID': "PID ââ paperIDs s' CID" using PID rs by (metis paperIDs_mono step)
      have uid': "isRevNth s' CID uid PID N" using uid step rs ph PID isRevNth_persistent by auto
      hence uuid': "isREVNth s' uid PID N" by (metis isREVNth_def)
      show "match ?Î s s1 vl1 a ou s' vll' â¨ ignore ?Î s s1 vl1 a ou s' vll'" (is "?match â¨ ?ignore")
      proof(cases "Ï ?trn")
        case False note Ï = False
        have vll': "vll' = vl" using c Ï unfolding consume_def by (cases vl) auto
        obtain ou1 and s1' where step1: "step s1 a = (ou1,s1')" by (metis prod.exhaust)
        let ?trn1 = "Trans s1 a ou1 s1'"
        have s's1': "eqExcPID_N s' s1'" using eqExcPID_N_step[OF ss1 step step1] .
        have Ï1: "Â¬ Ï ?trn1" using Ï unfolding eqExcPID_N_step_Ï[OF ss1 step step1] .
        have ?match proof
          show "validTrans ?trn1" using step1 by simp
        next
          show "consume ?trn1 vl1 vl1" unfolding consume_def using Ï1 by auto
        next
          show "Î³ ?trn = Î³ ?trn1" unfolding ss1 by simp
        next
          assume "Î³ ?trn" thus "g ?trn = g ?trn1"
          using eqExcPID_N_step_out[OF ss1 step step1 rsT rs1 PID ph] by simp
        next
          show "?Î s' vll' s1' vl1"
          proof(cases "?ph' = revPH â¨ ?ph' = disPH")
            case True
            hence "Î3 s' vll' s1' vl1" using PID' s's1' uuid' vlvl1 unfolding Î3_def B_def vll' by auto
            thus ?thesis by auto
          next
            case False hence ph': "?ph' > disPH" using ph rs step
            by (metis le_less less_antisym not_less phase_increases2 prod.sel(2))
            hence "Îe s' vll' s1' vl1" unfolding Îe_def vll' using PID' vlvl1 by auto
            thus ?thesis by auto
          qed
        qed
        thus ?thesis by simp
      next
        case True note Ï = True
        hence vll': "vll' = vl'" using c unfolding vl consume_def by simp
        obtain cid uid p rc where a:
        "a = Uact (uReview cid uid p PID N rc) â¨
         a = UUact (uuReview cid uid p PID N rc)" (is "a = ?A â¨ a = ?B")
        and ou: "ou = outOK" and v: "v = rc"
        using Ï c unfolding vl consume_def Ï_def2 vll' by fastforce
        hence cid: "cid = CID" using step apply(auto simp: u_defs uu_defs)
        (* crucial use of safety: *) by (metis PID paperIDs_equals rs)+
        have a: "(?ph = revPH â¶ a = ?A) â§ (?ph = disPH â¶ a = ?B)"
        using step ou a by (cases "a = ?A", auto simp: u_defs uu_defs cid)
        have Î³: "Â¬ Î³ ?trn" using step T rsT by (metis T_Ï_Î³ True)
        hence f: "f ?trn = v" using c Ï unfolding consume_def vl by auto
        have s's: "eqExcPID_N s' s" using eqExcPID_N_sym[OF Ï_step_eqExcPID_N[OF Ï step]] .
        have s's1: "eqExcPID_N s' s1" using eqExcPID_N_trans[OF s's ss1] .
        have ph': "phase s' CID = ?ph" using s's ph unfolding eqExcPID_N_def by auto
        show ?thesis
        proof(cases "vl' = []")
          case False note vl' = False
          hence vl'_vl1: "last vl' = last vl1" using vl_vl1 unfolding vl by auto
          have ?ignore proof
            show "Â¬ Î³ ?trn" by fact
          next
            show "?Î s' vll' s1 vl1"
            proof(cases "?ph' = revPH â¨ ?ph' = disPH")
              case True
              hence "Î3 s' vll' s1 vl1" using s's1 PID' uuid' vl' vl1 vl_vl1 unfolding Î3_def B_def vl vll' by auto
              thus ?thesis by auto
            next
              case False hence "?ph' > disPH" using ph rs step by (simp add: ph')
              hence "Îe s' vll' s1 vl1" unfolding Îe_def vll' using PID' vlvl1 vl' by auto
              thus ?thesis by auto
            qed
          qed
          thus ?thesis by auto
        next
          case True note vl' = True hence vl: "vl = [v]" unfolding vl by simp
(* the transition to Î4: Ï holds and both vl and vl1 are singletons: *)
          hence v1v: "v1 = v" using vl_vl1 unfolding vl1 by simp
          obtain s1' ou1 where step1: "step s1 a = (ou1,s1')" by (metis prod.exhaust)
          let ?trn1 = "Trans s1 a ou1 s1'"
          have Ï1: "Ï ?trn1" using eqExcPID_N_step_Ï_imp[OF ss1 step step1 Ï] .
          hence ou1: "ou1 = outOK" unfolding Ï_def2 by auto
          have uid'_uid1': "isRevNth s' CID uid PID N â§ isRevNth s1' CID uid PID N"
          using step step1 ou ou1 ph a apply(auto simp: u_defs uu_defs)
          by (metis cid isRev_imp_isRevNth_getReviewIndex)+
          hence N: "N < length (reviewsPaper (paper s' PID)) â§ N < length (reviewsPaper (paper s1' PID))"
          by (metis isRevNth_less_length reach_PairI rs rs1 step step1)
          hence l: "reviewsPaper (paper s' PID) ! N â  [] â§ reviewsPaper (paper s1' PID) ! N â  []"
          using step step1 ph a ou ou1 by (auto simp add: u_defs uu_defs)
          have ?match proof
          show "validTrans ?trn1" using step1 by simp
        next
          show "consume ?trn1 vl1 []" unfolding consume_def using Ï1 a ph
          by (auto simp add: a v vl1 v1v)
        next
          show "Î³ ?trn = Î³ ?trn1" unfolding ss1 by simp
        next
          assume "Î³ ?trn" thus "g ?trn = g ?trn1"
          using eqExcPID_N_step_out[OF ss1 step step1 rsT rs1 PID ph] by simp
        next
          have "Î4 s' vll' s1' []" unfolding vll' vl' Î4_def
          using ph' ph uuid' l eqExcPID_N_step_Ï_eqExcPID_N2[OF rs ss1 step step1 Ï] PID' by auto
          thus "?Î s' vll' s1' []" by simp
        qed
        thus ?thesis by simp
        qed
      qed
    qed
    thus ?thesis using vl by auto
  qed
qed

lemma unwind_cont_Î4: "unwind_cont Î4 {Î4,Îe}"
proof(rule, simp)
  let ?Î = "Î»s vl s1 vl1. Î4 s vl s1 vl1 â¨ Îe s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Î4 s vl s1 vl1"
  then obtain CID uid where uuid: "isREVNth s uid PID N"
  and rs: "reach s" and ph: "phase s CID â¥ revPH" (is "?ph â¥ _")
  and PID: "PID ââ paperIDs s CID"
  and decs: "(reviewsPaper (paper s PID))!N â  [] â§ (reviewsPaper (paper s1 PID))!N â  []"
  and ss1: "eqExcPID_N2 s s1" and vl: "vl = []" and vl1: "vl1 = []"
  using reachNT_reach unfolding Î4_def by auto
  hence uid: "isRevNth s CID uid PID N" by (metis isREVNth_imp_isRevNth)
  show "iaction ?Î s vl s1 vl1 â¨
        ((vl = [] â¶ vl1 = []) â§ reaction ?Î s vl s1 vl1)" (is "?iact â¨ (_ â§ ?react)")
  proof-
    have "?react"
    proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      let ?ph' = "phase s' CID"
      assume step: "step s a = (ou, s')" and T: "Â¬ T ?trn" and c: "consume ?trn vl vl'"
      have ph': "phase s' CID â¥ revPH" using ph rs isRevNth_geq_revPH isRevNth_persistent local.step reach_PairI uid by blast
      have PID': "PID ââ paperIDs s' CID" by (metis PID paperIDs_mono step)
      have uid': "isRevNth s' CID uid PID N" using isRevNth_persistent by (metis isRevNth_persistent rs step uid)
      hence uuid': "isREVNth s' uid PID N" by (metis isREVNth_def)
      show "match ?Î s s1 vl1 a ou s' vl' â¨ ignore ?Î s s1 vl1 a ou s' vl'" (is "?match â¨ ?ignore")
      proof-
        have Ï: "Â¬ Ï ?trn" and vl': "vl' = []" using c unfolding consume_def vl by auto
        obtain ou1 and s1' where step1: "step s1 a = (ou1,s1')" by (metis prod.exhaust)
        let ?trn1 = "Trans s1 a ou1 s1'"
        have s's1': "eqExcPID_N2 s' s1'" using eqExcPID_N2_step[OF ss1 step step1 rs uid] .
        have Ï1: "Â¬ Ï ?trn1" using Ï unfolding eqExcPID_N2_step_Ï[OF rs rs1 ss1 step step1] .
        have uid1: "isRevNth s1 CID uid PID N" using uid eqExcPID_N2_imp[OF ss1] by auto
        have decs': "(reviewsPaper (paper s' PID))!N â  []" "(reviewsPaper (paper s1' PID))!N â  []"
        using nonempty_reviews_persist rs rs1 step step1 uid uid1 decs by blast+
        have ?match proof
          show "validTrans ?trn1" using step1 by simp
        next
          show "consume ?trn1 vl1 vl1" unfolding consume_def using Ï1 by auto
        next
          show "Î³ ?trn = Î³ ?trn1" unfolding ss1 by simp
        next
          assume "Î³ ?trn" thus "g ?trn = g ?trn1"
          using eqExcPID_N2_step_out[OF ss1 step step1 rsT rs1 uid ph _ decs] by simp
        next
          have "Î4 s' vl' s1' vl1" using ph' uuid' s's1' PID' unfolding Î4_def vl1 vl' by (auto simp: decs')
          thus "?Î s' vl' s1' vl1" by simp
        qed
        thus ?thesis by simp
      qed
    qed
    thus ?thesis using vl1 by simp
  qed
qed


(* Exit arguments: *)
definition K1exit where
"K1exit cid s â¡ PID ââ paperIDs s cid â§ phase s cid > revPH â§ Â¬ (â uid. isRevNth s cid uid PID N)"

lemma invarNT_K1exit: "invarNT (K1exit cid)"
unfolding invarNT_def apply (safe dest!: reachNT_reach)
  subgoal for _ a apply(cases a)
    subgoal for x1 apply(cases x1) apply (fastforce simp add: c_defs K1exit_def geq_noPH_confIDs)+ .
    subgoal for x2 apply(cases x2) apply (fastforce simp add: u_defs K1exit_def paperIDs_equals)+ .
    subgoal for x3 apply(cases x3) apply (fastforce simp add: uu_defs K1exit_def)+ .
    by auto
done

lemma noVal_K1exit: "noVal (K1exit cid) v"
  apply(rule noÏ_noVal)
  unfolding noÏ_def apply safe
  subgoal for _ a apply(cases a)
    subgoal by (fastforce simp add: c_defs K1exit_def)
    subgoal for x2 apply(cases x2) apply (auto simp add: u_defs K1exit_def)
     apply (metis less_not_refl paperIDs_equals reachNT_reach) .
    subgoal for x3 apply(cases x3) apply (auto simp add: uu_defs K1exit_def)
      apply (metis isRev_def3 paperIDs_equals reachNT_reach) .
    by auto
done

definition K2exit where
"K2exit cid s â¡ PID ââ paperIDs s cid â§ phase s cid > disPH"

lemma invarNT_K2exit: "invarNT (K2exit cid)"
unfolding invarNT_def apply (safe dest!: reachNT_reach)
  subgoal for _ a apply(cases a)
    subgoal for x1 apply(cases x1) apply (fastforce simp add: c_defs K2exit_def geq_noPH_confIDs)+ .
    subgoal for x2 apply(cases x2) apply (fastforce simp add: u_defs K2exit_def paperIDs_equals)+ .
    subgoal for x3 apply(cases x3) apply (fastforce simp add: uu_defs K2exit_def)+ .
    by auto
  done

lemma noVal_K2exit: "noVal (K2exit cid) v"
  apply(rule noÏ_noVal)
  unfolding noÏ_def apply safe
  subgoal for _ a apply(cases a)
    subgoal by (fastforce simp add: c_defs K2exit_def)
    subgoal for x2 apply(cases x2) apply (auto simp add: u_defs K2exit_def)
      using paperIDs_equals reachNT_reach apply fastforce .
    subgoal for x3 apply(cases x3) apply (auto simp add: uu_defs K2exit_def)
      using paperIDs_equals reachNT_reach apply fastforce .
    by auto
done

lemma unwind_exit_Îe: "unwind_exit Îe"
proof
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and Îe: "Îe s vl s1 vl1"
  hence vl: "vl â  []" using reachNT_reach unfolding Îe_def by auto
  then obtain CID where "K1exit CID s â¨ K2exit CID s" using Îe
  unfolding K1exit_def K2exit_def Îe_def isREVNth_def by auto
  thus "vl â  [] â§ exit s (hd vl)" apply(simp add: vl)
  by (metis rsT exitI2 invarNT_K1exit noVal_K1exit invarNT_K2exit noVal_K2exit)
qed

theorem secure: secure
apply(rule unwind_decomp4_secure[of Î1 Î2 Îe Î3 Î4])
using
istate_Î1
unwind_cont_Î1 unwind_cont_Î2 unwind_cont_Î2 unwind_cont_Î3 unwind_cont_Î4
unwind_exit_Îe
by auto


end

ad>

Theory Review_RAut_NCPC_PAut

theory Review_RAut_NCPC_PAut
imports "../Observation_Setup" Review_Value_Setup "Bounded_Deducibility_Security.Compositional_Reasoning"
begin

subsection â¹Confidentiality from users who are not the review's author, a PC member, or an author of the paperâº

text â¹We verify the following property:

\ \\
A group of users UIDs learn nothing
about the various updates to the N'th review of a paper PID
(save for the inexistence of any updates) unless/until
\begin{itemize}
\item a user in UIDs is the review's author, or
\item a user in UIDs becomes a PC member in the paper's conference
having no conflict with that paper and the
conference moves to the discussion phase, or
\item a user in UIDs become a PC member in the paper's conference
or an author of the paper and the conference moves to the notification phase
\end{itemize}
âº

type_synonym "value" = rcontent

fun f :: "(state,act,out) trans â value" where
"f (Trans _ (Uact (uReview cid uid p pid n rc)) _ _) = rc"
|
"f (Trans _ (UUact (uuReview cid uid p pid n rc)) _ _) = rc"

fun T :: "(state,act,out) trans â bool" where
"T (Trans _ _ ou s') =
 (â uid â UIDs.
    isREVNth s' uid PID N
    â¨
    (â cid. PID ââ paperIDs s' cid â§ isPC s' cid uid â§ pref s' uid PID â  Conflict â§ phase s' cid â¥ disPH)
    â¨
    (â cid. PID ââ paperIDs s' cid â§ isPC s' cid uid â§ phase s' cid â¥ notifPH)
    â¨
    isAUT s' uid PID â§ (â cid. PID ââ paperIDs s' cid â§ phase s' cid â¥ notifPH)
 )"

declare T.simps [simp del]

definition B :: "value list â value list â bool" where
"B vl vl1 â¡ vl â  []"

interpretation BD_Security_IO where
istate = istate and step = step and
Ï = Ï and f = f and Î³ = Î³ and g = g and T = T and B = B
done

lemma reachNT_non_isPC_isChair:
assumes "reachNT s" and "uid â UIDs"
shows
"Â¬ isRevNth s cid uid PID N â§
 (PID ââ paperIDs s cid â§ isPC s cid uid â¶
    (pref s uid PID = Conflict â¨ phase s cid < disPH) â§ phase s cid < notifPH) â§
 (PID ââ paperIDs s cid â§ isChair s cid uid â¶
    (pref s uid PID = Conflict â¨ phase s cid < disPH) â§ phase s cid < notifPH) â§
 (isAut s cid uid PID â¶ phase s cid < notifPH)"
using assms apply induct
apply (auto simp: istate_def)[]
apply(intro conjI)
  subgoal for trn apply(cases trn, simp add: T.simps reachNT_reach isAUT_def isREVNth_def)[] .
  subgoal for trn apply(cases trn, simp add: T.simps reachNT_reach isAUT_def isREVNth_def)[]
    apply (metis not_less) .
  subgoal for trn apply(cases trn, simp add: T.simps reachNT_reach isAUT_def isREVNth_def)[]
    apply (metis isChair_isPC not_less reachNT_reach reach_PairI) .
  subgoal for trn apply(cases trn, simp add: T.simps reachNT_reach isAUT_def isREVNth_def)[]
    apply (metis isAut_paperIDs not_less reachNT_reach reach_PairI) .
done

lemma T_Ï_Î³:
assumes 1: "reachNT s" and 2: "step s a = (ou,s')" "Ï (Trans s a ou s')"
shows "Â¬ Î³ (Trans s a ou s')"
using reachNT_non_isPC_isChair[OF 1] 2 unfolding T.simps Ï_def2
apply (auto simp: u_defs uu_defs isRev_imp_isRevNth_getReviewIndex)
by (metis isRev_imp_isRevNth_getReviewIndex)+

(* major *) lemma eqExcPID_N_step_out:
assumes s's1': "eqExcPID_N s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and sT: "reachNT s" and s1: "reach s1"
and PID: "PID ââ paperIDs s cid"
and UIDs: "userOfA a â UIDs"
shows "ou = ou1"
proof-
  note s = reachNT_reach[OF sT]
  note Inv = reachNT_non_isPC_isChair[OF sT UIDs]
  note eqs = eqExcPID_N_imp[OF s's1']
  note eqs' = eqExcPID_N_imp1[OF s's1']
  note eqss = eqExcPID_N_imp2[OF s's1'] eqExcPID_N_imp3'[OF s s's1']

  note simps[simp] = c_defs u_defs uu_defs r_defs l_defs Paper_dest_conv eqExcPID_N_def eeqExcPID_N_def eqExcD
  note * = step step1 eqs eqs' eqss s s1 UIDs PID paperIDs_equals[OF s] Inv

  show ?thesis
  proof (cases a)
    case (Cact x1)
    with * show ?thesis by (cases x1; auto)
  next
    case (Uact x2)
    with * show ?thesis by (cases x2; auto)
  next
    case (UUact x3)
    with * show ?thesis by (cases x3; auto)
  next
    case (Ract x4)
    with * show ?thesis
    proof (cases x4)
      case (rMyReview x81 x82 x83 x84)
      with Ract * show ?thesis
        by clarsimp (metis getRevRole_Some_Rev_isRevNth)
    next
      case (rReviews x91 x92 x93 x94)
      with Ract * show ?thesis
        by clarsimp (metis not_less)
    next
      case (rFinalReviews x121 x122 x123 x124)
      with Ract * show ?thesis
        by clarsimp (metis not_less)
    qed auto
  next
    case (Lact x5)
    with * show ?thesis by (cases x5; auto; presburger)
  qed
qed

definition Î1 :: "state â value list â state â value list â bool" where
"Î1 s vl s1 vl1 â¡
 (â cid. PID ââ paperIDs s cid â¶ phase s cid < revPH) â§ s = s1 â§ B vl vl1"

definition Î2 :: "state â value list â state â value list â bool" where
"Î2 s vl s1 vl1 â¡
 â cid.
   PID ââ paperIDs s cid â§ phase s cid = revPH â§
   Â¬ (â uid. isREVNth s uid PID N) â§
   s = s1 â§ B vl vl1"

(* Note: In the similar property from discussion confidentiality we have only 3 non-exit phases
instead of 4, not having a phase like Î2: this is because there the agent affecting the documents (chairs),
must have been assigned in a previous phase; here reviewers are assigned in the same phase
in which they can edit.   *)

definition Î3 :: "state â value list â state â value list â bool" where
"Î3 s vl s1 vl1 â¡
 â cid uid. PID ââ paperIDs s cid â§ phase s cid = revPH â§ isREVNth s uid PID N â§ eqExcPID_N s s1"

definition Î4 :: "state â value list â state â value list â bool" where
"Î4 s vl s1 vl1 â¡
 â cid. PID ââ paperIDs s cid â§ phase s cid > revPH â§ eqExcPID_N s s1 â§ vl1 = []"

definition Îe :: "state â value list â state â value list â bool" where
"Îe s vl s1 vl1 â¡
 vl â  [] â§
 (â cid. PID ââ paperIDs s cid â§ phase s cid > revPH â§ Â¬ (â uid. isREVNth s uid PID N))"

lemma istate_Î1:
assumes B: "B vl vl1"
shows "Î1 istate vl istate vl1"
using B unfolding Î1_def B_def istate_def by auto

lemma unwind_cont_Î1: "unwind_cont Î1 {Î1,Î2,Îe}"
proof(rule, simp)
  let ?Î = "Î»s vl s1 vl1. Î1 s vl s1 vl1 â¨ Î2 s vl s1 vl1 â¨ Îe s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Î1 s vl s1 vl1"
  hence rs: "reach s" and ss1: "s1 = s" and vl: "vl â  []"
  and PID_ph: "â cid. PID ââ paperIDs s cid â¹ phase s cid < revPH"
  using reachNT_reach unfolding Î1_def B_def by auto
  show "iaction ?Î s vl s1 vl1 â¨
        ((vl = [] â¶ vl1 = []) â§ reaction ?Î s vl s1 vl1)" (is "?iact â¨ (_ â§ ?react)")
  proof-
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"  let ?trn1 = "Trans s1 a ou s'"
      assume step: "step s a = (ou, s')" and T: "Â¬ T ?trn" and c: "consume ?trn vl vl'"
      have Ï: "Â¬ Ï ?trn"
        apply(cases a)
        subgoal by simp
        subgoal for x2 apply(cases x2) using step PID_ph by (fastforce simp: u_defs)+
        subgoal for x3 apply(cases x3) using step PID_ph by (fastforce simp: uu_defs)+
        by simp_all
      hence vl': "vl' = vl" using c unfolding consume_def by auto
      show "match ?Î s s1 vl1 a ou s' vl' â¨ ignore ?Î s s1 vl1 a ou s' vl'" (is "?match â¨ ?ignore")
      proof-
        have ?match proof
          show "validTrans ?trn1" unfolding ss1 using step by simp
        next
          show "consume ?trn1 vl1 vl1" unfolding consume_def ss1 using Ï by auto
        next
          show "Î³ ?trn = Î³ ?trn1" unfolding ss1 by simp
        next
          assume "Î³ ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
        next
          show "?Î s' vl' s' vl1"
          proof(cases "â cid. PID ââ paperIDs s cid")
            case False note PID = False
            have PID_ph': "â cid. PID ââ paperIDs s' cid â¹ phase s' cid < revPH" using PID step rs
            apply(cases a)
              subgoal for _ x1 apply(cases x1) apply(fastforce simp: c_defs)+ .
              subgoal for _ x2 apply(cases x2) apply(fastforce simp: u_defs)+ .
              subgoal for _ x3 apply(cases x3) apply(fastforce simp: uu_defs)+ .
              by auto
            hence "Î1 s' vl' s' vl1" unfolding Î1_def B_def vl' using PID_ph' vl by auto
            thus ?thesis by auto
          next
            case True
            then obtain CID where PID: "PID ââ paperIDs s CID" by auto
            hence ph: "phase s CID < revPH" using PID_ph by auto
            have PID': "PID ââ paperIDs s' CID" by (metis PID paperIDs_mono step)
            show ?thesis
            proof(cases "phase s' CID < revPH")
              case True note ph' = True
              hence "Î1 s' vl' s' vl1" unfolding Î1_def B_def vl' using vl ph' PID' apply auto
              by (metis reach_PairI paperIDs_equals rs step)
              thus ?thesis by auto
            next
              case False note ph' = False
              have "Â¬ (â uid. isRevNth s CID uid PID N)" using rs ph isRevNth_geq_revPH by fastforce
              hence ph_isRev': "phase s' CID = revPH â§ Â¬ (â uid. isRevNth s' CID uid PID N)"
              using ph' ph PID step rs
              apply(cases a)
                subgoal for x1 apply(cases x1) apply(fastforce simp: c_defs)+ .
                subgoal for x2 apply(cases x2) apply(fastforce simp: u_defs)+ .
                subgoal for x3 apply(cases x3) apply(fastforce simp: uu_defs)+ .
              by auto
              hence "Â¬ (â uid. isREVNth s' uid PID N)"
              by (metis PID' isREVNth_imp_isRevNth reach_PairI rs1 ss1 step)
              hence "Î2 s' vl' s' vl1"
              unfolding Î2_def B_def isREVNth_def vl' using vl ph' PID' ph_isRev' by auto
              thus ?thesis by auto
            qed
          qed
        qed
        thus ?thesis by simp
      qed
    qed
    thus ?thesis using vl by auto
  qed
qed

lemma unwind_cont_Î2: "unwind_cont Î2 {Î2,Î3,Îe}"
proof(rule, simp)
  let ?Î = "Î»s vl s1 vl1. Î2 s vl s1 vl1 â¨ Î3 s vl s1 vl1 â¨ Îe s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Î2 s vl s1 vl1"
  then obtain CID where rs: "reach s" and ph: "phase s CID = revPH" (is "?ph = _")
  and PID: "PID ââ paperIDs s CID" and ss1: "s1 = s"
  and vl: "vl â  []" and uid: "Â¬ (â uid. isREVNth s uid PID N)"
  using reachNT_reach unfolding Î2_def B_def by auto
  hence uid: "Â¬ (â uid. isRevNth s CID uid PID N)" by (metis isREVNth_def)
  show "iaction ?Î s vl s1 vl1 â¨
        ((vl = [] â¶ vl1 = []) â§ reaction ?Î s vl s1 vl1)" (is "?iact â¨ (_ â§ ?react)")
  proof-
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"  let ?trn1 = "Trans s1 a ou s'"
      let ?ph' = "phase s' CID"
      assume step: "step s a = (ou, s')" and T: "Â¬ T ?trn" and c: "consume ?trn vl vl'"
      have Ï: "Â¬ Ï ?trn"
        apply(cases a)
        subgoal by simp
        subgoal for x2 apply(cases x2)
          using step ph uid apply (auto simp: u_defs isRev_def3)
          by (metis PID paperIDs_equals rs)
        subgoal for x3 apply(cases x3)
          using step ph apply (auto simp: uu_defs)
          by (metis PID n_not_Suc_n paperIDs_equals rs)
        by simp_all
      hence vl': "vl' = vl" using c unfolding consume_def by auto
      have PID': "PID ââ paperIDs s' CID" by (metis paperIDs_mono step PID)
      show "match ?Î s s1 vl1 a ou s' vl' â¨ ignore ?Î s s1 vl1 a ou s' vl'" (is "?match â¨ ?ignore")
      proof-
        have ?match proof
          show "validTrans ?trn1" unfolding ss1 using step by simp
        next
          show "consume ?trn1 vl1 vl1" unfolding consume_def ss1 using Ï by auto
        next
          show "Î³ ?trn = Î³ ?trn1" unfolding ss1 by simp
        next
          assume "Î³ ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
        next
          show "?Î s' vl' s' vl1"
          proof(cases "?ph' = revPH")
            case True note ph' = True
            show ?thesis
            proof(cases "â uid. isRevNth s' CID uid PID N")
              case False
              hence "Â¬ (â uid. isREVNth s' uid PID N)"
              by (metis reach_PairI PID' isREVNth_imp_isRevNth rs1 ss1 step)
              hence "Î2 s' vl' s' vl1" unfolding Î2_def B_def vl' using vl ph' PID' by auto
              thus ?thesis by auto
            next
              case True  hence "â uid. isREVNth s' uid PID N" by (metis isREVNth_def)
              hence "Î3 s' vl' s' vl1" unfolding Î3_def vl' using vl ph' PID' by auto
              thus ?thesis by auto
            qed
          next
            case False hence 1: "?ph' > revPH â§ Â¬ (â uid. isRevNth s' CID uid PID N)"
              using PID ph uid step rs
              apply(cases a)
              subgoal for x1 apply(cases x1) apply(fastforce simp: c_defs)+ .
              subgoal for x2 apply(cases x2) apply(fastforce simp: u_defs)+ .
              subgoal for x3 apply(cases x3) apply(fastforce simp: uu_defs)+ .
              by auto
            hence "Â¬ (â uid. isREVNth s' uid PID N)"
            by (metis reach_PairI PID' isREVNth_imp_isRevNth rs1 ss1 step)
            hence "Îe s' vl' s' vl1" unfolding Îe_def vl' using vl PID' 1 by auto
            thus ?thesis by auto
          qed
        qed
        thus ?thesis by simp
      qed
    qed
    thus ?thesis using vl by simp
  qed
qed

lemma unwind_cont_Î3: "unwind_cont Î3 {Î3,Î4,Îe}"
proof(rule, simp)
  let ?Î = "Î»s vl s1 vl1. Î3 s vl s1 vl1 â¨ Î4 s vl s1 vl1 â¨ Îe s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Î3 s vl s1 vl1"
  then obtain CID uid where uuid: "isREVNth s uid PID N"
  and rs: "reach s" and ph: "phase s CID = revPH" (is "?ph = _") and ss1: "eqExcPID_N s s1"
  and PID: "PID ââ paperIDs s CID" using reachNT_reach unfolding Î3_def by blast
  hence uid: "isRevNth s CID uid PID N" by (metis isREVNth_imp_isRevNth)
  hence uid_notin: "uid â UIDs" using reachNT_non_isPC_isChair[OF rsT] by auto
  show "iaction ?Î s vl s1 vl1 â¨
        ((vl = [] â¶ vl1 = []) â§ reaction ?Î s vl s1 vl1)" (is "?iact â¨ (_ â§ ?react)")
  proof(cases vl1)
    case (Cons v1 vl1') note vl1 = Cons
    have uid1: "isRevNth s CID uid PID N" using ss1 uid unfolding eqExcPID_N_def by auto
    define a1 where "a1 â¡ Uact (uReview CID uid (pass s uid) PID N v1)"
    obtain s1' ou1 where step1: "step s1 a1 = (ou1,s1')" by (metis prod.exhaust)
    let ?trn1 = "Trans s1 a1 ou1 s1'"
    have s1s1': "eqExcPID_N s1 s1'" using a1_def step1 uReview_uuReview_step_eqExcPID_N by blast
    have ss1': "eqExcPID_N s s1'" using eqExcPID_N_trans[OF ss1 s1s1'] .
    hence many_s1': "PID ââ paperIDs s1' CID" "isRevNth s1' CID uid PID N"
    "phase s1' CID = revPH" "pass s1' uid = pass s uid"
    using uid PID ph unfolding eqExcPID_N_def by auto
    hence more_s1': "uid ââ userIDs s1'" "CID ââ confIDs s1'"
    by (metis paperIDs_confIDs reach_PairI roles_userIDs rs1 step1 many_s1'(1))+
    have f: "f ?trn1 = v1" unfolding a1_def by simp
    have rs1': "reach s1'" using rs1 step1 by (auto intro: reach_PairI)
    have ou1: "ou1 = outOK"
    using step1 uid1 ph unfolding a1_def apply ( simp add: u_defs uu_defs many_s1' more_s1' isRev_def2)
    by (metis isRevNth_getReviewIndex many_s1' rs1)
    have ?iact proof
      show "step s1 a1 = (ou1,s1')" by fact
    next
      show Ï: "Ï ?trn1" using ou1 unfolding a1_def by simp
      thus "consume ?trn1 vl1 vl1'" using f unfolding consume_def vl1 by simp
    next
      show "Â¬ Î³ ?trn1" by (simp add: a1_def uid_notin)
    next
      have "Î3 s vl s1' vl1'" unfolding Î3_def using ph PID ss1' uuid by auto
      thus "?Î s vl s1' vl1'" by simp
    qed
    thus ?thesis by auto
  next
    case Nil note vl1 = Nil
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      let ?ph' = "phase s' CID"
      assume step: "step s a = (ou, s')" and T: "Â¬ T ?trn" and c: "consume ?trn vl vl'"
      have PID': "PID ââ paperIDs s' CID" using PID rs by (metis paperIDs_mono step)
      have uid': "isRevNth s' CID uid PID N"
      using uid step rs ph PID isRevNth_persistent by auto
      have uuid': "isREVNth s' uid PID N" by (metis isREVNth_def uid')
      show "match ?Î s s1 vl1 a ou s' vl' â¨ ignore ?Î s s1 vl1 a ou s' vl'" (is "?match â¨ ?ignore")
      proof(cases "Ï ?trn")
        case False note Ï = False
        have vl: "vl' = vl" using c Ï unfolding consume_def by (cases vl) auto
        obtain ou1 and s1' where step1: "step s1 a = (ou1,s1')" by (metis prod.exhaust)
        let ?trn1 = "Trans s1 a ou1 s1'"
        have s's1': "eqExcPID_N s' s1'" using eqExcPID_N_step[OF ss1 step step1] .
        have Ï1: "Â¬ Ï ?trn1" using Ï unfolding eqExcPID_N_step_Ï[OF ss1 step step1] .
        have ?match proof
          show "validTrans ?trn1" using step1 by simp
        next
          show "consume ?trn1 vl1 vl1" unfolding consume_def using Ï1 by auto
        next
          show "Î³ ?trn = Î³ ?trn1" unfolding ss1 by simp
        next
          assume "Î³ ?trn" thus "g ?trn = g ?trn1"
          using eqExcPID_N_step_out[OF ss1 step step1 rsT rs1 PID] by simp
        next
          show "?Î s' vl' s1' vl1"
          proof(cases "?ph' = revPH")
            case True
            hence "Î3 s' vl' s1' vl1" using PID' s's1' uuid' unfolding Î3_def by auto
            thus ?thesis by auto
          next
            case False hence "?ph' > revPH"
            using ph rs step by (metis le_less phase_increases2 prod.sel(2))
            hence "Î4 s' vl' s1' vl1" using s's1' PID' unfolding Î4_def vl1 by auto
            thus ?thesis by auto
          qed
        qed
        thus ?thesis by simp
      next
        case True note Ï = True
        have s's: "eqExcPID_N s' s" using eqExcPID_N_sym[OF Ï_step_eqExcPID_N[OF Ï step]] .
        have s's1: "eqExcPID_N s' s1" using eqExcPID_N_trans[OF s's ss1] .
        have ?ignore proof
          show "Â¬ Î³ ?trn" using T_Ï_Î³ Ï rsT step by auto
        next
          show "?Î s' vl' s1 vl1"
          proof(cases "?ph' = revPH")
            case True
            hence "Î3 s' vl' s1 vl1" using s's1 PID' uuid' unfolding Î3_def by auto
            thus ?thesis by auto
          next
            case False hence "?ph' > revPH"
            using ph rs step using eqExcPID_N_def s's by auto
            hence "Î4 s' vl' s1 vl1" using s's1 PID' unfolding Î4_def vl1 by auto
            thus ?thesis by auto
          qed
        qed
        thus ?thesis by auto
      qed
    qed
    thus ?thesis using vl1 by auto
  qed
qed

lemma unwind_cont_Î4: "unwind_cont Î4 {Î4,Îe}"
proof(rule, simp)
  let ?Î = "Î»s vl s1 vl1. Î4 s vl s1 vl1 â¨ Îe s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Î4 s vl s1 vl1"
  then obtain CID where rs: "reach s" and ph: "phase s CID > revPH" (is "?ph > _")
  and PID: "PID ââ paperIDs s CID" and ss1: "eqExcPID_N s s1" and vl1: "vl1 = []"
  using reachNT_reach unfolding Î4_def by auto
  show "iaction ?Î s vl s1 vl1 â¨
        ((vl = [] â¶ vl1 = []) â§ reaction ?Î s vl s1 vl1)" (is "?iact â¨ (_ â§ ?react)")
  proof-
    have "?react"
    proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      let ?ph' = "phase s' CID"
      assume step: "step s a = (ou, s')" and T: "Â¬ T ?trn" and c: "consume ?trn vl vl'"
      have PID': "PID ââ paperIDs s' CID" using PID rs by (metis paperIDs_mono step)
      have ph': "phase s' CID > revPH" using ph rs by (meson less_le_trans local.step phase_increases)
      show "match ?Î s s1 vl1 a ou s' vl' â¨ ignore ?Î s s1 vl1 a ou s' vl'" (is "?match â¨ ?ignore")
      proof(cases "Ï ?trn")
        case False note Ï = False
        have vl: "vl' = vl" using c Ï unfolding consume_def by (cases vl) auto
        obtain ou1 and s1' where step1: "step s1 a = (ou1,s1')" by (metis prod.exhaust)
        let ?trn1 = "Trans s1 a ou1 s1'"
        have s's1': "eqExcPID_N s' s1'" using eqExcPID_N_step[OF ss1 step step1] .
        have Ï1: "Â¬ Ï ?trn1" using Ï unfolding eqExcPID_N_step_Ï[OF ss1 step step1] .
        have ?match proof
          show "validTrans ?trn1" using step1 by simp
        next
          show "consume ?trn1 vl1 vl1" unfolding consume_def using Ï1 by auto
        next
          show "Î³ ?trn = Î³ ?trn1" unfolding ss1 by simp
        next
          assume "Î³ ?trn" thus "g ?trn = g ?trn1"
          using eqExcPID_N_step_out[OF ss1 step step1 rsT rs1 PID] by simp
        next
          have "Î4 s' vl' s1' vl1" using ph' PID' s's1' unfolding Î4_def vl1 by auto
          thus "?Î s' vl' s1' vl1" by simp
        qed
        thus ?thesis by simp
      next
        case True note Ï = True
        have s's: "eqExcPID_N s' s" using eqExcPID_N_sym[OF Ï_step_eqExcPID_N[OF Ï step]] .
        have s's1: "eqExcPID_N s' s1" using eqExcPID_N_trans[OF s's ss1] .
        have ?ignore proof
          show "Â¬ Î³ ?trn" using T_Ï_Î³ Ï rsT step by auto
        next
          have "Î4 s' vl' s1 vl1" using s's1 PID' ph' vl1 unfolding Î4_def by auto
          thus "?Î s' vl' s1 vl1" by auto
        qed
        thus ?thesis by simp
      qed
    qed
    thus ?thesis using vl1 by simp
  qed
qed

(* Exit arguments: *)
definition K1exit where
"K1exit cid s â¡ PID ââ paperIDs s cid â§ phase s cid > revPH â§ Â¬ (â uid. isRevNth s cid uid PID N)"

lemma invarNT_K1exit: "invarNT (K1exit cid)"
unfolding invarNT_def apply (safe dest!: reachNT_reach)
  subgoal for _ a apply(cases a)
    subgoal for x1 apply(cases x1) apply (fastforce simp add: c_defs K1exit_def geq_noPH_confIDs)+ .
    subgoal for x2 apply(cases x2) apply (fastforce simp add: u_defs K1exit_def paperIDs_equals)+ .
    subgoal for x3 apply(cases x3) apply (fastforce simp add: uu_defs K1exit_def)+ .
    by auto
  done

lemma noVal_K1exit: "noVal (K1exit cid) v"
apply(rule noÏ_noVal)
unfolding noÏ_def apply safe
  subgoal for _ a apply(cases a)
    subgoal by (fastforce simp add: c_defs K1exit_def)
    subgoal for x2 apply(cases x2) apply (auto simp add: u_defs K1exit_def)
      apply (metis less_not_refl paperIDs_equals reachNT_reach) .
    subgoal for x3 apply(cases x3) apply (auto simp add: uu_defs K1exit_def)
      apply (metis isRev_def3 paperIDs_equals reachNT_reach) .
    by auto
  done

lemma unwind_exit_Îe: "unwind_exit Îe"
proof
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and Îe: "Îe s vl s1 vl1"
  hence vl: "vl â  []" using reachNT_reach unfolding Îe_def by auto
  then obtain CID where "K1exit CID s" using Îe unfolding K1exit_def Îe_def isREVNth_def by auto
  thus "vl â  [] â§ exit s (hd vl)" apply(simp add: vl)
  by (metis rsT exitI2 invarNT_K1exit noVal_K1exit)
qed

theorem secure: secure
apply(rule unwind_decomp4_secure[of Î1 Î2 Îe Î3 Î4])
using
istate_Î1
unwind_cont_Î1 unwind_cont_Î2 unwind_cont_Î3 unwind_cont_Î4
unwind_exit_Îe
by auto

end

Theory Discussion_NCPC

theory Discussion_NCPC
imports "../Observation_Setup" Discussion_Value_Setup "Bounded_Deducibility_Security.Compositional_Reasoning"
begin

subsection â¹Confidentiality protection from non-PC-membersâº

text â¹We verify the following property:

\ \\
A group of users UIDs learn
nothing about the various updates of a paper's discussion
(i.e., about the comments being posted on a paper by the PC members)
(save for the non-existence of any edit)
unless/until a user in UIDs becomes a PC member in the paper's conference having no conflict with that paper
and the conference moves to the discussion phase.

\ \\
âº

fun T :: "(state,act,out) trans â bool" where
"T (Trans _ _ ou s') =
 (â uid â UIDs. â cid.
    PID ââ paperIDs s' cid â§ isPC s' cid uid â§ pref s' uid PID â  Conflict â§ phase s' cid â¥ disPH
 )"

declare T.simps [simp del]

definition B :: "value list â value list â bool" where
"B vl vl1 â¡ vl â  []"

interpretation BD_Security_IO where
istate = istate and step = step and
Ï = Ï and f = f and Î³ = Î³ and g = g and T = T and B = B
done

lemma reachNT_non_isPC_isChair:
assumes "reachNT s" and "uid â UIDs"
shows
"(PID ââ paperIDs s cid â§ isPC s cid uid â§ phase s cid â¥ disPH â¶ pref s uid PID = Conflict) â§
 (PID ââ paperIDs s cid â§ isChair s cid uid â§ phase s cid â¥ disPH â¶ pref s uid PID = Conflict)"
  using assms
  apply induct
   apply (auto simp: istate_def)[]
  apply(intro conjI)
  subgoal for trn apply(cases trn, auto simp: T.simps reachNT_reach)[] .
  by (metis T.elims(3) isChair_isPC reachNT_reach reach.Step tgtOf_simps)


lemma T_Ï_Î³:
assumes 1: "reachNT s" and 2: "step s a = (ou,s')" "Ï (Trans s a ou s')"
shows "Â¬ Î³ (Trans s a ou s')"
using reachNT_non_isPC_isChair[OF 1] 2 unfolding Ï_def2
by (fastforce simp add: uu_defs)

(* major *) lemma eqExcPID_step_out:
assumes s's1': "eqExcPID s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and sT: "reachNT s" and s1: "reach s1"
and PID: "PID ââ paperIDs s cid"
and UIDs: "userOfA a â UIDs"
shows "ou = ou1"
proof-
  note Inv = reachNT_non_isPC_isChair[OF sT UIDs]
  note eqs = eqExcPID_imp[OF s's1']
  note eqs' = eqExcPID_imp1[OF s's1']
  note s = reachNT_reach[OF sT]

  note simps[simp] = c_defs u_defs uu_defs r_defs l_defs Paper_dest_conv eqExcPID_def eeqExcPID_def eqExcD
  note * = step step1 eqs eqs' s s1 PID UIDs paperIDs_equals[OF s] Inv

  show ?thesis
  proof (cases a)
    case (Cact x1)
    then show ?thesis using * by (cases x1) auto
  next
    case (Uact x2)
    then show ?thesis using * by (cases x2) auto
  next
    case (UUact x3)
    then show ?thesis using * by (cases x3) auto
  next
    case (Ract x4)
    show ?thesis
    proof (cases x4)
      case (rMyReview x81 x82 x83 x84)
      then show ?thesis using * Ract by (auto simp add: getNthReview_def)
    next
      case (rReviews x91 x92 x93 x94)
      then show ?thesis using * Ract by (clarsimp; metis eqExcPID_imp2 s's1')
    next
      case (rDis x111 x112 x113 x114)
      then show ?thesis using * Ract by (clarsimp; metis discussion.inject)
    qed (use * Ract in auto)
  next
    case (Lact x5)
    then show ?thesis using * by (cases x5; auto; presburger)
  qed
qed

definition Î1 :: "state â value list â state â value list â bool" where
"Î1 s vl s1 vl1 â¡
 (â cid. PID ââ paperIDs s cid â¶ phase s cid < disPH) â§ s = s1 â§ B vl vl1"

(* main difference from the Paper_Confidentiality/Aut_PC: need to assume
that there are means to produce vl1 via iaction when disPH has been reached;
if not, this yields and exit *)
definition Î2 :: "state â value list â state â value list â bool" where
"Î2 s vl s1 vl1 â¡
 â cid uid.
    PID ââ paperIDs s cid â§ phase s cid = disPH â§
    isPC s cid uid â§ pref s uid PID â  Conflict
    â§ eqExcPID s s1"

definition Î3 :: "state â value list â state â value list â bool" where
"Î3 s vl s1 vl1 â¡
 â cid. PID ââ paperIDs s cid â§ phase s cid > disPH â§ eqExcPID s s1 â§ vl1 = []"

definition Îe :: "state â value list â state â value list â bool" where
"Îe s vl s1 vl1 â¡
 vl â  [] â§
 (â cid. PID ââ paperIDs s cid â§ phase s cid â¥ disPH â§
         Â¬ (â uid. isPC s cid uid â§ pref s uid PID â  Conflict)
 )"

lemma init_Î1:
assumes B: "B vl vl1"
shows "Î1 istate vl istate vl1"
using B unfolding Î1_def B_def istate_def by auto

lemma unwind_cont_Î1: "unwind_cont Î1 {Î1,Î2,Îe}"
proof(rule, simp)
  let ?Î = "Î»s vl s1 vl1. Î1 s vl s1 vl1 â¨ Î2 s vl s1 vl1 â¨ Îe s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Î1 s vl s1 vl1"
  hence rs: "reach s" and ss1: "s1 = s" and vl: "vl â  []"
  and PID_ph: "â cid. PID ââ paperIDs s cid â¹ phase s cid < disPH"
  using reachNT_reach unfolding Î1_def B_def by auto
  show "iaction ?Î s vl s1 vl1 â¨
        ((vl = [] â¶ vl1 = []) â§ reaction ?Î s vl s1 vl1)" (is "?iact â¨ (_ â§ ?react)")
  proof-
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"  let ?trn1 = "Trans s1 a ou s'"
      assume step: "step s a = (ou, s')" and T: "Â¬ T ?trn" and c: "consume ?trn vl vl'"
      have Ï: "Â¬ Ï ?trn"
      proof (cases a)
        case (UUact x3)
        then show ?thesis
          using step PID_ph
          by (cases x3; fastforce simp: uu_defs)
      qed auto
      hence vl': "vl' = vl" using c unfolding consume_def by auto
      show "match ?Î s s1 vl1 a ou s' vl' â¨ ignore ?Î s s1 vl1 a ou s' vl'" (is "?match â¨ ?ignore")
      proof-
        have ?match proof
          show "validTrans ?trn1" unfolding ss1 using step by simp
        next
          show "consume ?trn1 vl1 vl1" unfolding consume_def ss1 using Ï by auto
        next
          show "Î³ ?trn = Î³ ?trn1" unfolding ss1 by simp
        next
          assume "Î³ ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
        next
          show "?Î s' vl' s' vl1"
          proof(cases "â cid. PID ââ paperIDs s cid")
            case False note PID = False
            have ph_PID': "â cid. PID ââ paperIDs s' cid â¹ phase s' cid < disPH" using PID step rs
            subgoal apply(cases a)
              subgoal for x1 apply(cases x1) apply(fastforce simp: c_defs)+ .
              subgoal for x2 apply(cases x2) apply(fastforce simp: u_defs)+ .
              subgoal for x3 apply(cases x3) apply(fastforce simp: uu_defs)+ .
              by auto
            done
            hence "Î1 s' vl' s' vl1" unfolding Î1_def B_def vl' using ph_PID' vl by auto
            thus ?thesis by auto
          next
            case True then obtain CID where PID: "PID ââ paperIDs s CID" by auto
            hence ph: "phase s CID < disPH" (is "?ph < _") using PID_ph by auto
            show ?thesis
            proof(cases "phase s' CID < disPH")
              case True note ph' = True
              show ?thesis proof(cases "PID ââ paperIDs s' CID")
                case False
                hence "Î1 s' vl' s' vl1" unfolding Î1_def B_def vl' using vl ph' apply auto
                by (metis PID paperIDs_mono step)(* safety crucially used *)
                thus ?thesis by auto
              next
                case True
                hence "Î1 s' vl' s' vl1" unfolding Î1_def B_def vl' using vl ph' apply auto
                by (metis reach_PairI paperIDs_equals rs step) (* safety crucially used *)
                thus ?thesis by auto
              qed
            next
              case False
              hence ph': "phase s' CID = disPH â§ PID ââ paperIDs s' CID"
              using PID ph step rs
              subgoal apply(cases a)
                subgoal for x1 apply(cases x1) apply(fastforce simp: c_defs)+ .
                subgoal for x2 apply(cases x2) apply(fastforce simp: u_defs)+ .
                subgoal for x3 apply(cases x3) apply(fastforce simp: uu_defs)+ .
              by auto
            done
              show ?thesis
              proof(cases "âuid. isPC s' CID uid â§ pref s' uid PID â  Conflict")
                case True
                hence "Î2 s' vl' s' vl1" unfolding Î2_def vl' using vl ph' by auto
                thus ?thesis by auto
              next
                case False
                hence "Îe s' vl' s' vl1" unfolding Îe_def vl' using vl ph' by auto
                thus ?thesis by auto
              qed
            qed
          qed
        qed
        thus ?thesis by simp
      qed
    qed
    thus ?thesis using vl by auto
  qed
qed

lemma unwind_cont_Î2: "unwind_cont Î2 {Î2,Î3,Îe}"
proof(rule, simp)
  let ?Î = "Î»s vl s1 vl1. Î2 s vl s1 vl1 â¨ Î3 s vl s1 vl1 â¨ Îe s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Î2 s vl s1 vl1"
  then obtain CID uid where uid: "isPC s CID uid" "pref s uid PID â  Conflict"
  and rs: "reach s" and ph: "phase s CID = disPH" (is "?ph = _")
  and PID: "PID ââ paperIDs s CID" and ss1: "eqExcPID s s1"
  using reachNT_reach unfolding Î2_def by auto
  hence uid_notin: "uid â UIDs" using ph reachNT_non_isPC_isChair[OF rsT] by force
  show "iaction ?Î s vl s1 vl1 â¨
        ((vl = [] â¶ vl1 = []) â§ reaction ?Î s vl s1 vl1)" (is "?iact â¨ (_ â§ ?react)")
  proof(cases vl1)
    case (Cons v1 vl1') note vl1 = Cons
    have uid1: "isPC s1 CID uid" "pref s1 uid PID â  Conflict"
    using ss1 uid unfolding eqExcPID_def by auto
    define a1 where "a1 â¡ UUact (uuDis CID uid (pass s uid) PID v1)"
    obtain s1' ou1 where step1: "step s1 a1 = (ou1,s1')" by (metis prod.exhaust)
    let ?trn1 = "Trans s1 a1 ou1 s1'"
    have s1s1': "eqExcPID s1 s1'" using a1_def step1 UUact_uuDis_step_eqExcPID by auto
    have ss1': "eqExcPID s s1'" using eqExcPID_trans[OF ss1 s1s1'] .
    hence many_s1': "PID ââ paperIDs s1' CID" "isPC s1' CID uid"
    "pref s1' uid PID â  Conflict" "phase s1' CID = disPH"
    "pass s1' uid = pass s uid"
    using uid PID ph unfolding eqExcPID_def by auto
    hence more_s1': "uid ââ userIDs s1'" "CID ââ confIDs s1'"
    by (metis paperIDs_confIDs reach_PairI roles_userIDs rs1 step1 many_s1'(1))+
    have f: "f ?trn1 = v1" unfolding a1_def by simp
    have rs1': "reach s1'" using rs1 step1 by (auto intro: reach_PairI)
    have ou1: "ou1 = outOK"
    using step1 uid1 ph unfolding a1_def by (auto simp add: uu_defs many_s1' more_s1')
    have ?iact proof
      show "step s1 a1 = (ou1,s1')" by fact
    next
      show Ï: "Ï ?trn1" using ou1 unfolding a1_def by simp
      thus "consume ?trn1 vl1 vl1'" using f unfolding consume_def vl1 by simp
    next
      show "Â¬ Î³ ?trn1" by (simp add: a1_def uid_notin)
    next
      have "Î2 s vl s1' vl1'" unfolding Î2_def using ph PID ss1' uid by auto
      thus "?Î s vl s1' vl1'" by simp
    qed
    thus ?thesis by auto
  next
    case Nil note vl1 = Nil
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      let ?ph' = "phase s' CID"
      assume step: "step s a = (ou, s')" and T: "Â¬ T ?trn" and c: "consume ?trn vl vl'"
      have PID': "PID ââ paperIDs s' CID" using PID rs by (metis paperIDs_mono step)
      have uid': "isPC s' CID uid â§ pref s' uid PID â  Conflict"
      using uid step rs ph PID pref_Conflict_disPH isPC_persistent by auto
      show "match ?Î s s1 vl1 a ou s' vl' â¨ ignore ?Î s s1 vl1 a ou s' vl'" (is "?match â¨ ?ignore")
      proof(cases "Ï ?trn")
        case False note Ï = False
        have vl: "vl' = vl" using c Ï unfolding consume_def by (cases vl) auto
        obtain ou1 and s1' where step1: "step s1 a = (ou1,s1')" by (metis prod.exhaust)
        let ?trn1 = "Trans s1 a ou1 s1'"
        have s's1': "eqExcPID s' s1'" using eqExcPID_step[OF ss1 step step1] .
        have Ï1: "Â¬ Ï ?trn1" using Ï unfolding eqExcPID_step_Ï[OF ss1 step step1] .
        have ?match proof
          show "validTrans ?trn1" using step1 by simp
        next
          show "consume ?trn1 vl1 vl1" unfolding consume_def using Ï1 by auto
        next
          show "Î³ ?trn = Î³ ?trn1" unfolding ss1 by simp
        next
          assume "Î³ ?trn" thus "g ?trn = g ?trn1"
          using eqExcPID_step_out[OF ss1 step step1 rsT rs1 PID] by simp
        next
          show "?Î s' vl' s1' vl1"
          proof(cases "?ph' = disPH")
            case True
            hence "Î2 s' vl' s1' vl1" using PID' s's1' uid' unfolding Î2_def by auto
            thus ?thesis by auto
          next
            case False hence "?ph' > disPH"
            using ph rs step by (metis le_less phase_increases)
            hence "Î3 s' vl' s1' vl1" using s's1' PID' unfolding Î3_def vl1 by auto
            thus ?thesis by auto
          qed
        qed
        thus ?thesis by simp
      next
        case True note Ï = True
        have s's: "eqExcPID s' s" using eqExcPID_sym[OF Ï_step_eqExcPID[OF Ï step]] .
        have s's1: "eqExcPID s' s1" using eqExcPID_trans[OF s's ss1] .
        have ?ignore proof
          show "Â¬ Î³ ?trn" using T_Ï_Î³ Ï rsT step by auto
        next
          show "?Î s' vl' s1 vl1"
          proof(cases "?ph' = disPH")
            case True
            hence "Î2 s' vl' s1 vl1" using s's1 PID' uid' unfolding Î2_def by auto
            thus ?thesis by auto
          next
            case False hence "?ph' > disPH"
            using ph rs step by (metis le_less phase_increases)
            hence "Î3 s' vl' s1 vl1" using s's1 PID' unfolding Î3_def vl1 by auto
            thus ?thesis by auto
          qed
        qed
        thus ?thesis by auto
      qed
    qed
    thus ?thesis using vl1 by auto
  qed
qed

lemma unwind_cont_Î3: "unwind_cont Î3 {Î3,Îe}"
proof(rule, simp)
  let ?Î = "Î»s vl s1 vl1. Î3 s vl s1 vl1 â¨ Îe s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Î3 s vl s1 vl1"
  then obtain CID where rs: "reach s" and ph: "phase s CID > disPH" (is "?ph < _")
  and PID: "PID ââ paperIDs s CID"
  and ss1: "eqExcPID s s1" and vl1: "vl1 = []"
  using reachNT_reach unfolding Î3_def by auto
  show "iaction ?Î s vl s1 vl1 â¨
        ((vl = [] â¶ vl1 = []) â§ reaction ?Î s vl s1 vl1)" (is "?iact â¨ (_ â§ ?react)")
  proof-
    have "?react"
    proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      let ?ph' = "phase s' CID"
      assume step: "step s a = (ou, s')" and T: "Â¬ T ?trn" and c: "consume ?trn vl vl'"
      have PID': "PID ââ paperIDs s' CID" using PID rs by (metis paperIDs_mono step)
      have ph': "phase s' CID > disPH" using ph rs by (meson less_le_trans local.step phase_increases)
      show "match ?Î s s1 vl1 a ou s' vl' â¨ ignore ?Î s s1 vl1 a ou s' vl'" (is "?match â¨ ?ignore")
      proof-
        have Ï: "Â¬ Ï ?trn" using ph step unfolding Ï_def2 apply (auto simp: uu_defs)
        using PID less_not_refl2 paperIDs_equals rs by blast (* safety crucialy used *)
        have vl: "vl' = vl" using c Ï unfolding consume_def by (cases vl) auto
        obtain ou1 and s1' where step1: "step s1 a = (ou1,s1')" by (metis prod.exhaust)
        let ?trn1 = "Trans s1 a ou1 s1'"
        have s's1': "eqExcPID s' s1'" using eqExcPID_step[OF ss1 step step1] .
        have Ï1: "Â¬ Ï ?trn1" using Ï unfolding eqExcPID_step_Ï[OF ss1 step step1] .
        have ?match proof
          show "validTrans ?trn1" using step1 by simp
        next
          show "consume ?trn1 vl1 vl1" unfolding consume_def using Ï1 by auto
        next
          show "Î³ ?trn = Î³ ?trn1" unfolding ss1 by simp
        next
          assume "Î³ ?trn" thus "g ?trn = g ?trn1"
          using eqExcPID_step_out[OF ss1 step step1 rsT rs1 PID] by simp
        next
          have "Î3 s' vl' s1' vl1" using ph' PID' s's1' unfolding Î3_def vl1 by auto
          thus "?Î s' vl' s1' vl1" by simp
        qed
        thus ?thesis by simp
      qed
    qed
    thus ?thesis using vl1 by simp
  qed
qed

(* Exit arguments: *)
definition K1exit where
"K1exit cid s â¡
 (PID ââ paperIDs s cid â§ phase s cid â¥ disPH â§
  Â¬ (â uid. isPC s cid uid â§ pref s uid PID â  Conflict))"

lemma invarNT_K1exit: "invarNT (K1exit cid)"
unfolding invarNT_def apply (safe dest!: reachNT_reach)
  subgoal for _ a apply(cases a)
    subgoal for x1 apply(cases x1) apply (fastforce simp add: c_defs K1exit_def geq_noPH_confIDs)+ .
    subgoal for x2
      apply(cases x2)
            apply (fastforce simp add: u_defs K1exit_def paperIDs_equals)
           apply (fastforce simp add: u_defs K1exit_def paperIDs_equals)
          apply (fastforce simp add: u_defs K1exit_def paperIDs_equals)
         apply (fastforce simp add: u_defs K1exit_def paperIDs_equals)
        apply (fastforce simp add: u_defs K1exit_def paperIDs_equals)
        subgoal for x61 apply(cases "x61 = cid")
           apply (fastforce simp add: u_defs K1exit_def paperIDs_equals)+ .
        apply (fastforce simp add: u_defs K1exit_def paperIDs_equals) .
    subgoal for x3 apply(cases x3) apply (fastforce simp add: uu_defs K1exit_def)+ .
    by auto
  done

lemma noVal_K1exit: "noVal (K1exit cid) v"
apply(rule noÏ_noVal)
unfolding noÏ_def apply safe
  subgoal for _ a apply(cases a)
        apply (fastforce simp add: c_defs K1exit_def)
       apply (fastforce simp add: c_defs K1exit_def)
    subgoal for x3
      apply(cases x3) apply (auto simp add: uu_defs K1exit_def)
      apply (metis paperIDs_equals reachNT_reach) (* crucial use of safety *) .
    by auto
  done

lemma unwind_exit_Îe: "unwind_exit Îe"
proof
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and Îe: "Îe s vl s1 vl1"
  hence vl: "vl â  []" using reachNT_reach unfolding Îe_def by auto
  then obtain CID where "K1exit CID s" using Îe unfolding K1exit_def Îe_def by auto
  thus "vl â  [] â§ exit s (hd vl)" apply(simp add: vl)
  by (metis rsT exitI2 invarNT_K1exit noVal_K1exit)
qed

theorem secure: secure
apply(rule unwind_decomp3_secure[of Î1 Î2 Îe Î3])
using
init_Î1
unwind_cont_Î1 unwind_cont_Î2 unwind_cont_Î3
unwind_exit_Îe
by auto

end

Theory Decision_Value_Setup

theory Decision_Value_Setup
imports Decision_Intro
begin

text â¹The ID of the paper under scrutiny:âº

consts PID :: paperID

subsection â¹Preliminariesâº

declare updates_commute_paper[simp]

(* two papers equal everywhere but w.r.t. decision: *)
fun eqExcD :: "paper â paper â bool" where
"eqExcD (Paper title abstract ct reviews dis decs)
        (Paper title1 abstract1 ct1 reviews1 dis1 decs1) =
 (title = title1 â§ abstract = abstract1 â§ ct = ct1 â§ reviews = reviews1 â§ dis = dis1)"

lemma eqExcD:
"eqExcD pap pap1 =
 (titlePaper pap = titlePaper pap1 â§ abstractPaper pap = abstractPaper pap1 â§
  contentPaper pap = contentPaper pap1 â§
  reviewsPaper pap = reviewsPaper pap1 â§ disPaper pap = disPaper pap1)"
by(cases pap, cases pap1, auto)

lemma eqExcD_eq[simp,intro!]: "eqExcD pap pap"
by(cases pap) auto

lemma eqExcD_sym:
assumes "eqExcD pap pap1"
shows "eqExcD pap1 pap"
apply(cases pap, cases pap1)
using assms by auto

lemma eqExcD_trans:
assumes "eqExcD pap pap1" and "eqExcD pap1 pap2"
shows "eqExcD pap pap2"
apply(cases pap, cases pap1, cases pap2)
using assms by auto

(* Auxiliary notion:  *)
definition eeqExcPID where
"eeqExcPID paps paps1 â¡
 â pid. if pid = PID then eqExcD (paps pid) (paps1 pid) else paps pid = paps1 pid"

lemma eeqExcPID_eeq[simp,intro!]: "eeqExcPID s s"
unfolding eeqExcPID_def by auto

lemma eeqExcPID_sym:
assumes "eeqExcPID s s1" shows "eeqExcPID s1 s"
using assms eqExcD_sym unfolding eeqExcPID_def by auto

lemma eeqExcPID_trans:
assumes "eeqExcPID s s1" and "eeqExcPID s1 s2" shows "eeqExcPID s s2"
using assms eqExcD_trans unfolding eeqExcPID_def by simp blast

lemma eeqExcPID_imp:
"eeqExcPID paps paps1 â¹ eqExcD (paps PID) (paps1 PID)"
"â¦eeqExcPID paps paps1; pid â  PIDâ§ â¹ paps pid = paps1 pid"
unfolding eeqExcPID_def by auto

lemma eeqExcPID_cong:
assumes "eeqExcPID paps paps1"
and "pid = PID â¹ eqExcD uu uu1"
and "pid â  PID â¹ uu = uu1"
shows "eeqExcPID (paps (pid := uu)) (paps1(pid := uu1))"
using assms unfolding eeqExcPID_def by auto

lemma eeqExcPID_RDD:
"eeqExcPID paps paps1 â¹
 titlePaper (paps PID) = titlePaper (paps1 PID) â§
 abstractPaper (paps PID) = abstractPaper (paps1 PID) â§
 contentPaper (paps PID) = contentPaper (paps1 PID) â§
 reviewsPaper (paps PID) = reviewsPaper (paps1 PID) â§
 disPaper (paps PID) = disPaper (paps1 PID)"
using eeqExcPID_def unfolding eqExcD by auto

(* The notion of two states being equal everywhere but on the decision of
   the paper associated to a given PID *)
definition eqExcPID :: "state â state â bool" where
"eqExcPID s s1 â¡
 confIDs s = confIDs s1 â§ conf s = conf s1 â§
 userIDs s = userIDs s1 â§ pass s = pass s1 â§ user s = user s1 â§ roles s = roles s1 â§
 paperIDs s = paperIDs s1
 â§
 eeqExcPID (paper s) (paper s1)
 â§
 pref s = pref s1 â§
 voronkov s = voronkov s1 â§
 news s = news s1 â§ phase s = phase s1"

lemma eqExcPID_eq[simp,intro!]: "eqExcPID s s"
unfolding eqExcPID_def by auto

lemma eqExcPID_sym:
assumes "eqExcPID s s1" shows "eqExcPID s1 s"
using assms eeqExcPID_sym unfolding eqExcPID_def by auto

lemma eqExcPID_trans:
assumes "eqExcPID s s1" and "eqExcPID s1 s2" shows "eqExcPID s s2"
using assms eeqExcPID_trans unfolding eqExcPID_def by auto

(* Implications from eqExcPID, including w.r.t. auxiliary operations: *)
lemma eqExcPID_imp:
"eqExcPID s s1 â¹
 confIDs s = confIDs s1 â§ conf s = conf s1 â§
 userIDs s = userIDs s1 â§ pass s = pass s1 â§ user s = user s1 â§ roles s = roles s1 â§
 paperIDs s = paperIDs s1
 â§
 eeqExcPID (paper s) (paper s1)
 â§
 pref s = pref s1 â§
 voronkov s = voronkov s1 â§
 news s = news s1 â§ phase s = phase s1 â§

 getAllPaperIDs s = getAllPaperIDs s1 â§
 isRev s cid uid pid = isRev s1 cid uid pid â§
 getReviewIndex s cid uid pid = getReviewIndex s1 cid uid pid â§
 getRevRole s cid uid pid = getRevRole s1 cid uid pid"
unfolding eqExcPID_def getAllPaperIDs_def
unfolding isRev_def getReviewIndex_def getRevRole_def by auto

lemma eqExcPID_imp1:
"eqExcPID s s1 â¹ eqExcD (paper s pid) (paper s1 pid)"
"eqExcPID s s1 â¹ pid â  PID â¨ PID â  pid â¹
    paper s pid = paper s1 pid â§
    getNthReview s pid n = getNthReview s1 pid n"
unfolding eqExcPID_def getNthReview_def eeqExcPID_def
apply auto
by (metis eqExcD_eq)

lemma eqExcPID_imp2:
assumes "eqExcPID s s1" and "pid â  PID â¨ PID â  pid"
shows "getReviewersReviews s cid pid = getReviewersReviews s1 cid pid"
proof-
  have
  "(Î»uID. if isRev s cid uID pid then [(uID, getNthReview s pid (getReviewIndex s cid uID pid))] else []) =
   (Î»uID. if isRev s1 cid uID pid then [(uID, getNthReview s1 pid (getReviewIndex s1 cid uID pid))] else [])"
  apply(rule ext)
  using assms by (auto simp: eqExcPID_imp eqExcPID_imp1)
  thus ?thesis unfolding getReviewersReviews_def using assms by (simp add: eqExcPID_imp)
qed

lemma eqExcPID_RDD:
"eqExcPID s s1 â¹
 titlePaper (paper s PID) = titlePaper (paper s1 PID) â§
 abstractPaper (paper s PID) = abstractPaper (paper s1 PID) â§
 contentPaper (paper s PID) = contentPaper (paper s1 PID) â§
 reviewsPaper (paper s PID) = reviewsPaper (paper s1 PID) â§
 disPaper (paper s PID) = disPaper (paper s1 PID)"
using eqExcPID_imp eeqExcPID_RDD by auto

lemma eqExcPID_cong[simp, intro]:
"â uu1 uu2. eqExcPID s s1 â¹ uu1 = uu2 â¹ eqExcPID (s â¦confIDs := uu1â¦) (s1 â¦confIDs := uu2â¦)"
"â uu1 uu2. eqExcPID s s1 â¹ uu1 = uu2 â¹ eqExcPID (s â¦conf := uu1â¦) (s1 â¦conf := uu2â¦)"

"â uu1 uu2. eqExcPID s s1 â¹ uu1 = uu2 â¹ eqExcPID (s â¦userIDs := uu1â¦) (s1 â¦userIDs := uu2â¦)"
"â uu1 uu2. eqExcPID s s1 â¹ uu1 = uu2 â¹ eqExcPID (s â¦pass := uu1â¦) (s1 â¦pass := uu2â¦)"
"â uu1 uu2. eqExcPID s s1 â¹ uu1 = uu2 â¹ eqExcPID (s â¦user := uu1â¦) (s1 â¦user := uu2â¦)"
"â uu1 uu2. eqExcPID s s1 â¹ uu1 = uu2 â¹ eqExcPID (s â¦roles := uu1â¦) (s1 â¦roles := uu2â¦)"

"â uu1 uu2. eqExcPID s s1 â¹ uu1 = uu2 â¹ eqExcPID (s â¦paperIDs := uu1â¦) (s1 â¦paperIDs := uu2â¦)"
"â uu1 uu2. eqExcPID s s1 â¹ eeqExcPID uu1 uu2 â¹ eqExcPID (s â¦paper := uu1â¦) (s1 â¦paper := uu2â¦)"

"â uu1 uu2. eqExcPID s s1 â¹ uu1 = uu2 â¹ eqExcPID (s â¦pref := uu1â¦) (s1 â¦pref := uu2â¦)"
"â uu1 uu2. eqExcPID s s1 â¹ uu1 = uu2 â¹ eqExcPID (s â¦voronkov := uu1â¦) (s1 â¦voronkov := uu2â¦)"
"â uu1 uu2. eqExcPID s s1 â¹ uu1 = uu2 â¹ eqExcPID (s â¦news := uu1â¦) (s1 â¦news := uu2â¦)"
"â uu1 uu2. eqExcPID s s1 â¹ uu1 = uu2 â¹ eqExcPID (s â¦phase := uu1â¦) (s1 â¦phase := uu2â¦)"
unfolding eqExcPID_def by auto

lemma eqExcPID_Paper:
assumes s's1': "eqExcPID s s1"
and "paper s pid = Paper title abstract content reviews dis decs"
and "paper s1 pid = Paper title1 abstract1 content1 reviews1 dis1 decs1"
shows "title = title1 â§ abstract = abstract1 â§ content = content1 â§ reviews = reviews1 â§ dis = dis1"
using assms unfolding eqExcPID_def apply (auto simp: eqExcD eeqExcPID_def)
by (metis titlePaper.simps abstractPaper.simps contentPaper.simps reviewsPaper.simps disPaper.simps
          )+

text â¹Weaker equivalence relations that allow differences in the final decision.  This is used for
verifying the confidentiality property that only protects earlier updates to the decision.âº

(* two papers equal everywhere but w.r.t. the tail of the decision: *)
fun eqExcD2 :: "paper â paper â bool" where
"eqExcD2 (Paper title abstract ct reviews dis decs )
         (Paper title1 abstract1 ct1 reviews1 dis1 decs1) =
 (title = title1 â§ abstract = abstract1 â§ ct = ct1 â§ reviews = reviews1 â§ dis = dis1 â§
 hd decs = hd decs1)"

lemma eqExcD2:
"eqExcD2 pap pap1 =
 (titlePaper pap = titlePaper pap1 â§ abstractPaper pap = abstractPaper pap1 â§
  contentPaper pap = contentPaper pap1 â§
  reviewsPaper pap = reviewsPaper pap1 â§ disPaper pap = disPaper pap1 â§
  hd (decsPaper pap) = hd (decsPaper pap1)
 )"
by(cases pap, cases pap1, auto)

lemma eqExcD2_eq[simp,intro!]: "eqExcD2 pap pap"
by(cases pap) auto

lemma eqExcD2_sym:
assumes "eqExcD2 pap pap1"
shows "eqExcD2 pap1 pap"
apply(cases pap, cases pap1)
using assms by auto

lemma eqExcD2_trans:
assumes "eqExcD2 pap pap1" and "eqExcD2 pap1 pap2"
shows "eqExcD2 pap pap2"
apply(cases pap, cases pap1, cases pap2)
using assms by auto

(* Auxiliary notion:  *)
definition eeqExcPID2 where
"eeqExcPID2 paps paps1 â¡
 â pid. if pid = PID then eqExcD2 (paps pid) (paps1 pid) else paps pid = paps1 pid"

lemma eeqExcPID2_eeq[simp,intro!]: "eeqExcPID2 s s"
unfolding eeqExcPID2_def by auto

lemma eeqExcPID2_sym:
assumes "eeqExcPID2 s s1" shows "eeqExcPID2 s1 s"
using assms eqExcD2_sym unfolding eeqExcPID2_def by auto

lemma eeqExcPID2_trans:
assumes "eeqExcPID2 s s1" and "eeqExcPID2 s1 s2" shows "eeqExcPID2 s s2"
using assms eqExcD2_trans unfolding eeqExcPID2_def by simp blast

lemma eeqExcPID2_imp:
"eeqExcPID2 paps paps1 â¹ eqExcD2 (paps PID) (paps1 PID)"
"â¦eeqExcPID2 paps paps1; pid â  PIDâ§ â¹ paps pid = paps1 pid"
unfolding eeqExcPID2_def by auto

lemma eeqExcPID2_cong:
assumes "eeqExcPID2 paps paps1"
and "pid = PID â¹ eqExcD2 uu uu1"
and "pid â  PID â¹ uu = uu1"
shows "eeqExcPID2 (paps (pid := uu)) (paps1(pid := uu1))"
using assms unfolding eeqExcPID2_def by auto

lemma eeqExcPID2_RDD:
"eeqExcPID2 paps paps1 â¹
 titlePaper (paps PID) = titlePaper (paps1 PID) â§
 abstractPaper (paps PID) = abstractPaper (paps1 PID) â§
 contentPaper (paps PID) = contentPaper (paps1 PID) â§
 reviewsPaper (paps PID) = reviewsPaper (paps1 PID) â§
 disPaper (paps PID) = disPaper (paps1 PID) â§
 hd (decsPaper (paps PID)) = hd (decsPaper (paps PID))"
using eeqExcPID2_def unfolding eqExcD2 by auto

(* The notion of two states being equal everywhere but on the tail of the decision of
   the paper associated to a given PID *)
definition eqExcPID2 :: "state â state â bool" where
"eqExcPID2 s s1 â¡
 confIDs s = confIDs s1 â§ conf s = conf s1 â§
 userIDs s = userIDs s1 â§ pass s = pass s1 â§ user s = user s1 â§ roles s = roles s1 â§
 paperIDs s = paperIDs s1
 â§
 eeqExcPID2 (paper s) (paper s1)
 â§
 pref s = pref s1 â§
 voronkov s = voronkov s1 â§
 news s = news s1 â§ phase s = phase s1"

lemma eqExcPID2_eq[simp,intro!]: "eqExcPID2 s s"
unfolding eqExcPID2_def by auto

lemma eqExcPID2_sym:
assumes "eqExcPID2 s s1" shows "eqExcPID2 s1 s"
using assms eeqExcPID2_sym unfolding eqExcPID2_def by auto

lemma eqExcPID2_trans:
assumes "eqExcPID2 s s1" and "eqExcPID2 s1 s2" shows "eqExcPID2 s s2"
using assms eeqExcPID2_trans unfolding eqExcPID2_def by auto

(* Implications from eqExcPID2, including w.r.t. auxiliary operations: *)
lemma eqExcPID2_imp:
"eqExcPID2 s s1 â¹
 confIDs s = confIDs s1 â§ conf s = conf s1 â§
 userIDs s = userIDs s1 â§ pass s = pass s1 â§ user s = user s1 â§ roles s = roles s1 â§
 paperIDs s = paperIDs s1
 â§
 eeqExcPID2 (paper s) (paper s1)
 â§
 pref s = pref s1 â§
 voronkov s = voronkov s1 â§
 news s = news s1 â§ phase s = phase s1 â§

 getAllPaperIDs s = getAllPaperIDs s1 â§
 isRev s cid uid pid = isRev s1 cid uid pid â§
 getReviewIndex s cid uid pid = getReviewIndex s1 cid uid pid â§
 getRevRole s cid uid pid = getRevRole s1 cid uid pid"
unfolding eqExcPID2_def getAllPaperIDs_def
unfolding isRev_def getReviewIndex_def getRevRole_def by auto

lemma eqExcPID2_imp1:
"eqExcPID2 s s1 â¹ eqExcD2 (paper s pid) (paper s1 pid)"
"eqExcPID2 s s1 â¹ pid â  PID â¨ PID â  pid â¹
    paper s pid = paper s1 pid â§
    getNthReview s pid n = getNthReview s1 pid n"
unfolding eqExcPID2_def getNthReview_def eeqExcPID2_def
apply auto
by (metis eqExcD2_eq)

lemma eqExcPID2_imp2:
assumes "eqExcPID2 s s1" and "pid â  PID â¨ PID â  pid"
shows "getReviewersReviews s cid pid = getReviewersReviews s1 cid pid"
proof-
  have
  "(Î»uID. if isRev s cid uID pid then [(uID, getNthReview s pid (getReviewIndex s cid uID pid))] else []) =
   (Î»uID. if isRev s1 cid uID pid then [(uID, getNthReview s1 pid (getReviewIndex s1 cid uID pid))] else [])"
  apply(rule ext)
  using assms by (auto simp: eqExcPID2_imp eqExcPID2_imp1)
  thus ?thesis unfolding getReviewersReviews_def using assms by (simp add: eqExcPID2_imp)
qed

lemma eqExcPID2_RDD:
"eqExcPID2 s s1 â¹
 titlePaper (paper s PID) = titlePaper (paper s1 PID) â§
 abstractPaper (paper s PID) = abstractPaper (paper s1 PID) â§
 contentPaper (paper s PID) = contentPaper (paper s1 PID) â§
 reviewsPaper (paper s PID) = reviewsPaper (paper s1 PID) â§
 disPaper (paper s PID) = disPaper (paper s1 PID)"
using eqExcPID2_imp eeqExcPID2_RDD by auto

lemma eqExcPID2_cong[simp, intro]:
"â uu1 uu2. eqExcPID2 s s1 â¹ uu1 = uu2 â¹ eqExcPID2 (s â¦confIDs := uu1â¦) (s1 â¦confIDs := uu2â¦)"
"â uu1 uu2. eqExcPID2 s s1 â¹ uu1 = uu2 â¹ eqExcPID2 (s â¦conf := uu1â¦) (s1 â¦conf := uu2â¦)"

"â uu1 uu2. eqExcPID2 s s1 â¹ uu1 = uu2 â¹ eqExcPID2 (s â¦userIDs := uu1â¦) (s1 â¦userIDs := uu2â¦)"
"â uu1 uu2. eqExcPID2 s s1 â¹ uu1 = uu2 â¹ eqExcPID2 (s â¦pass := uu1â¦) (s1 â¦pass := uu2â¦)"
"â uu1 uu2. eqExcPID2 s s1 â¹ uu1 = uu2 â¹ eqExcPID2 (s â¦user := uu1â¦) (s1 â¦user := uu2â¦)"
"â uu1 uu2. eqExcPID2 s s1 â¹ uu1 = uu2 â¹ eqExcPID2 (s â¦roles := uu1â¦) (s1 â¦roles := uu2â¦)"

"â uu1 uu2. eqExcPID2 s s1 â¹ uu1 = uu2 â¹ eqExcPID2 (s â¦paperIDs := uu1â¦) (s1 â¦paperIDs := uu2â¦)"
"â uu1 uu2. eqExcPID2 s s1 â¹ eeqExcPID2 uu1 uu2 â¹ eqExcPID2 (s â¦paper := uu1â¦) (s1 â¦paper := uu2â¦)"

"â uu1 uu2. eqExcPID2 s s1 â¹ uu1 = uu2 â¹ eqExcPID2 (s â¦pref := uu1â¦) (s1 â¦pref := uu2â¦)"
"â uu1 uu2. eqExcPID2 s s1 â¹ uu1 = uu2 â¹ eqExcPID2 (s â¦voronkov := uu1â¦) (s1 â¦voronkov := uu2â¦)"
"â uu1 uu2. eqExcPID2 s s1 â¹ uu1 = uu2 â¹ eqExcPID2 (s â¦news := uu1â¦) (s1 â¦news := uu2â¦)"
"â uu1 uu2. eqExcPID2 s s1 â¹ uu1 = uu2 â¹ eqExcPID2 (s â¦phase := uu1â¦) (s1 â¦phase := uu2â¦)"
unfolding eqExcPID2_def by auto

lemma eqExcPID2_Paper:
assumes s's1': "eqExcPID2 s s1"
and "paper s pid = Paper title abstract content reviews dis decs"
and "paper s1 pid = Paper title1 abstract1 content1 reviews1 dis1 decs1"
shows "title = title1 â§ abstract = abstract1 â§ content = content1 â§ reviews = reviews1 â§
    dis = dis1"
using assms unfolding eqExcPID2_def apply (auto simp: eqExcD2 eeqExcPID2_def)
  by (metis titlePaper.simps abstractPaper.simps contentPaper.simps reviewsPaper.simps
disPaper.simps)+


subsection â¹Value Setupâº

type_synonym "value" = decision

fun Ï :: "(state,act,out) trans â bool" where
"Ï (Trans _ (UUact (uuDec cid uid p pid dec)) ou _) = (pid = PID â§ ou = outOK)"
|
"Ï _ = False"

lemma Ï_def2:
"Ï (Trans s a ou s') = (â cid uid p dec. a = UUact (uuDec cid uid p PID dec) â§ ou = outOK)"
proof (cases a)
  case (UUact x3)
  then show ?thesis by (cases x3; auto)
qed auto

fun f :: "(state,act,out) trans â value" where
"f (Trans _ (UUact (uuDec cid uid p pid dec)) _ _) = dec"

lemma UUact_uuDec_step_eqExcPID:
assumes a: "a = UUact (uuDec cid uid p PID dec)"
and "step s a = (ou,s')"
shows "eqExcPID s s'"
using assms unfolding eqExcPID_def eeqExcPID_def by (auto simp: uu_defs)

lemma Ï_step_eqExcPID:
assumes Ï: "Ï (Trans s a ou s')"
and s: "step s a = (ou,s')"
shows "eqExcPID s s'"
using Ï UUact_uuDec_step_eqExcPID[OF _ s] unfolding Ï_def2 by blast

(* major *) lemma eqExcPID_step:
assumes s's1': "eqExcPID s s1"
and step: "step s a = (ou,s')"
and step1: "step s1 a = (ou1,s1')"
shows "eqExcPID s' s1'"
proof -
  note eqs = eqExcPID_imp[OF s's1']
  note eqs' = eqExcPID_imp1[OF s's1']

  note simps[simp] = c_defs u_defs uu_defs r_defs l_defs Paper_dest_conv eqExcPID_def eeqExcPID_def eqExcD
  note * = step step1 eqs eqs'

  then show ?thesis
  proof (cases a)
    case (Cact x1)
    then show ?thesis using * by (cases x1; auto)
  next
    case (Uact x2)
    then show ?thesis using * by (cases x2; auto)
  next
    case (UUact x3)
    then show ?thesis using * by (cases x3; auto)
  qed auto
qed

lemma eqExcPID_step_Ï_imp:
assumes s's1': "eqExcPID s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and Ï: "Ï (Trans s a ou s')"
shows "Ï (Trans s1 a ou1 s1')"
using assms unfolding Ï_def2 by (auto simp add: uu_defs eqExcPID_imp)

lemma eqExcPID_step_Ï:
assumes s's1': "eqExcPID s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
shows "Ï (Trans s a ou s') = Ï (Trans s1 a ou1 s1')"
by (metis eqExcPID_step_Ï_imp eqExcPID_sym assms)


(* These hold for eeqExcPID, but not for eeqExcPID2:
lemma UUact_uuDec_step_eqExcPID2:
assumes a: "a = UUact (uuDec cid uid p PID dec)"
and "step s a = (ou,s')"
shows "eqExcPID2 s s'"
using assms unfolding eqExcPID2_def eeqExcPID2_def by (auto simp: uu_defs)

lemma Ï_step_eqExcPID2:
assumes Ï: "Ï (Trans s a ou s')"
and s: "step s a = (ou,s')"
shows "eqExcPID2 s s'"
using Ï UUact_uuDec_step_eqExcPID2[OF _ s] unfolding Ï_def2 by blast
*)

(* major *) lemma eqExcPID2_step:
assumes s's1': "eqExcPID2 s s1"
and step: "step s a = (ou,s')"
and step1: "step s1 a = (ou1,s1')"
shows "eqExcPID2 s' s1'"
proof -
  note eqs = eqExcPID2_imp[OF s's1']
  note eqs' = eqExcPID2_imp1[OF s's1']

  note simps[simp] = c_defs u_defs uu_defs r_defs l_defs Paper_dest_conv eqExcPID2_def eeqExcPID2_def eqExcD2
  note * = s's1' step step1 eqs eqs'

  then show ?thesis
  proof (cases a)
    case (Cact x1)
    then show ?thesis using * by (cases x1; auto)
  next
    case (Uact x2)
    then show ?thesis using * by (cases x2; auto)
  next
    case (UUact x3)
    then show ?thesis using * by (cases x3; auto)
  qed auto
qed

lemma eqExcPID2_step_Ï_imp:
assumes s's1': "eqExcPID2 s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and Ï: "Ï (Trans s a ou s')"
shows "Ï (Trans s1 a ou1 s1')"
using assms unfolding Ï_def2 by (auto simp add: uu_defs eqExcPID2_imp)

lemma eqExcPID2_step_Ï:
assumes s's1': "eqExcPID2 s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
shows "Ï (Trans s a ou s') = Ï (Trans s1 a ou1 s1')"
by (metis eqExcPID2_step_Ï_imp eqExcPID2_sym assms)

end

ody>

Theory Decision_NCPC

theory Decision_NCPC
imports "../Observation_Setup" Decision_Value_Setup "Bounded_Deducibility_Security.Compositional_Reasoning"
begin

subsection â¹Confidentiality protection from non-PC-membersâº

text â¹We verify the following property:

\ \\
A group of users UIDs learn
nothing about the various updates of a paper's decision
except for the last edited version
unless/until
a user in UIDs becomes PC member in the paper's conference having no conflict with that paper
and the conference moves to the decision stage.

\ \\
âº

(* perhaps this should further strengthened *)

fun T :: "(state,act,out) trans â bool" where
"T (Trans _ _ ou s') =
 (â uid â UIDs. â cid.
    PID ââ paperIDs s' cid â§ isPC s' cid uid â§ pref s' uid PID â  Conflict â§
    phase s' cid â¥ disPH
 )"

declare T.simps [simp del]

definition B :: "value list â value list â bool" where
"B vl vl1 â¡ vl â  [] â§ vl1 â  [] â§ last vl = last vl1"

interpretation BD_Security_IO where
istate = istate and step = step and
Ï = Ï and f = f and Î³ = Î³ and g = g and T = T and B = B
done

lemma reachNT_non_isPC_isChair:
assumes "reachNT s" and "uid â UIDs"
shows
"(PID ââ paperIDs s cid â§ isPC s cid uid â§ phase s cid â¥ disPH â¶ pref s uid PID = Conflict) â§
 (PID ââ paperIDs s cid â§ isChair s cid uid â§ phase s cid â¥ disPH â¶ pref s uid PID = Conflict)"
  using assms
  apply induct
   apply (auto simp: istate_def)[]
  apply(intro conjI)
  subgoal for trn apply(cases trn, auto simp: T.simps reachNT_reach)[] .
  by (metis T.elims(3) isChair_isPC reachNT_reach reach.Step tgtOf_simps)

(* important: *) lemma T_Ï_Î³:
assumes 1: "reachNT s" and 2: "step s a = (ou,s')" "Ï (Trans s a ou s')"
shows "Â¬ Î³ (Trans s a ou s')"
using reachNT_non_isPC_isChair[OF 1] 2 unfolding T.simps Ï_def2
by (fastforce simp add: uu_defs)

lemma eqExcPID2_eqExcPID:
"eqExcPID2 s s1 â¹ eqExcPID s s1"
unfolding eqExcPID_def eqExcPID2_def eeqExcPID_def eeqExcPID2_def eqExcD2 eqExcD by auto

(* major *) lemma eqExcPID_step_out:
assumes s's1': "eqExcPID s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and sT: "reachNT s" and s1: "reach s1"
and PID: "PID ââ paperIDs s cid"
and ph: "phase s cid = disPH"
and UIDs: "userOfA a â UIDs"
shows "ou = ou1"
proof-
  note Inv = reachNT_non_isPC_isChair[OF sT UIDs]
  note eqs = eqExcPID_imp[OF s's1']
  note eqs' = eqExcPID_imp1[OF s's1']
  note s = reachNT_reach[OF sT]

  note simps[simp] = c_defs u_defs uu_defs r_defs l_defs Paper_dest_conv eqExcPID_def eeqExcPID_def eqExcD
  note * = step step1 eqs eqs' s s1 PID UIDs ph paperIDs_equals[OF s] Inv

  show ?thesis
  proof (cases a)
    case (Cact x1)
    then show ?thesis using * by (cases x1) auto
  next
    case (Uact x2)
    then show ?thesis using * by (cases x2) auto
  next
    case (UUact x3)
    then show ?thesis using * by (cases x3) auto
  next
    case (Ract x4)
    show ?thesis
    proof (cases x4)
      case (rMyReview x81 x82 x83 x84)
      then show ?thesis using * Ract by (auto simp add: getNthReview_def)
    next
      case (rReviews x91 x92 x93 x94)
      then show ?thesis using * Ract by (clarsimp; metis eqExcPID_imp2 s's1')
    next
      case (rDecs x101 x102 x103 x104)
      then show ?thesis using * Ract by (clarsimp; metis)
    next
      case (rFinalDec x131 x132 x133 x134)
      then show ?thesis using * Ract by (clarsimp; metis Suc_n_not_le_n)
    qed (use * Ract in auto)
  next
    case (Lact x5)
    then show ?thesis using * by (cases x5; auto; presburger)
  qed
qed

(* major *) lemma eqExcPID2_step_out:
assumes ss1: "eqExcPID2 s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and sT: "reachNT s" and s1: "reach s1"
and PID: "PID ââ paperIDs s cid"
and ph: "phase s cid â¥ disPH"
and UIDs: "userOfA a â UIDs"
and decs_exit: "decsPaper (paper s PID) â  []" "decsPaper (paper s1 PID) â  []"
shows "ou = ou1"
proof-
  note Inv = reachNT_non_isPC_isChair[OF sT UIDs]
  note eqs = eqExcPID2_imp[OF ss1]
  note eqs' = eqExcPID2_imp1[OF ss1]
  note s = reachNT_reach[OF sT]

  have "PID ââ paperIDs s1 cid" using PID ss1 unfolding eqExcPID2_def by auto
  hence decs_exit': "decsPaper (paper s' PID) â  []" "decsPaper (paper s1' PID) â  []"
  using nonempty_decsPaper_persist s s1 PID decs_exit step step1 by metis+

  note simps[simp] = c_defs u_defs uu_defs r_defs l_defs Paper_dest_conv eqExcPID2_def eeqExcPID2_def eqExcD2
  note * = step step1 eqs eqs' s s1 PID UIDs ph paperIDs_equals[OF s] Inv

  show ?thesis
  proof (cases a)
    case (Cact x1)
    then show ?thesis using * by (cases x1) auto
  next
    case (Uact x2)
    then show ?thesis using * by (cases x2) auto
  next
    case (UUact x3)
    then show ?thesis using * by (cases x3) auto
  next
    case (Ract x4)
    show ?thesis
    proof (cases x4)
      case (rMyReview x81 x82 x83 x84)
      then show ?thesis using * Ract by (auto simp add: getNthReview_def)
    next
      case (rReviews x91 x92 x93 x94)
      then show ?thesis using * Ract by (clarsimp; metis eqExcPID2_imp2 ss1)
    next
      case (rDecs x101 x102 x103 x104)
      then show ?thesis using * Ract by (clarsimp; metis)
    next
      case (rFinalDec x131 x132 x133 x134)
      then show ?thesis using * Ract by (clarsimp; metis decs_exit' list.sel(1) list.simps(5) neq_Nil_conv)
    qed (use * Ract in auto)
  next
    case (Lact x5)
    then show ?thesis using * by (cases x5; auto; presburger)
  qed
qed

lemma eqExcPID_step_eqExcPID2:
assumes a: "a = UUact (uuDec cid uid p PID dec)"
and ss1: "eqExcPID s s1"
and step: "step s a = (outOK,s')" and step1: "step s1 a = (outOK,s1')"
and s: "reach s" "reach s1" and PID: "PID ââ paperIDs s cid" and ph: "phase s cid < notifPH"
shows "eqExcPID2 s' s1'"
proof-
  have "eqExcPID s' s1'" using assms by (metis eqExcPID_step)
  moreover have "hd (decsPaper (paper s' PID)) = hd (decsPaper (paper s1' PID))"
    using step step1 unfolding a
    apply(simp add: uu_defs)
    by (metis decsPaper.simps fun_upd_same list.sel(1) select_convs(8) surjective update_convs(8))
  ultimately show ?thesis
    unfolding eqExcPID_def eqExcPID2_def eeqExcPID_def eeqExcPID2_def eqExcD2 eqExcD by auto
qed

(* major *) lemma eqExcPID_step_Ï_eqExcPID2:
assumes ss1: "eqExcPID s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and Ï: "Ï (Trans s a ou s')"
and s: "reach s" "reach s1" and PID: "PID ââ paperIDs s cid" and ph: "phase s cid â¤ disPH"
shows "eqExcPID2 s' s1'"
proof-
  obtain cid1 uid p dec where a: "a = UUact (uuDec cid1 uid p PID dec)" and ou: "ou = outOK"
  using Ï unfolding Ï_def2 by auto
  have PID1: "PID ââ paperIDs s cid1" using step unfolding a ou by (auto simp: uu_defs)
  hence cid1: "cid1 = cid" using paperIDs_equals[OF s(1) PID] by auto
  have Ï1: "Ï (Trans s1 a ou1 s1')" using Ï ss1 by (metis eqExcPID_step_Ï_imp step step1)
  hence ou1: "ou1 = outOK" using Ï unfolding Ï_def2 by auto
  show ?thesis
  using eqExcPID_step_eqExcPID2[OF a ss1 step[unfolded ou] step1[unfolded ou1] s]
  PID ph unfolding cid1 by auto
qed

definition Î1 :: "state â value list â state â value list â bool" where
"Î1 s vl s1 vl1 â¡
 (â cid. PID ââ paperIDs s cid â¶ phase s cid < disPH) â§
 s = s1 â§ B vl vl1"
(* "Critical phase not yet reached: either PID not yet registered
    or the phase of its conference not yet submission  " *)

definition Î2 :: "state â value list â state â value list â bool" where
"Î2 s vl s1 vl1 â¡
 â cid uid.
   PID ââ paperIDs s cid â§ phase s cid = disPH â§
   isChair s cid uid â§ pref s uid PID â  Conflict â§
   eqExcPID s s1 â§ B vl vl1"
(* "PID registered to a conference which is in the discussion phase, values not completely flushed,
    state equality only up to the decision for PID which is a singleton list;
    assumption that there exists at least a non-conflict chair of the conference
    (the situation when no such chair exists is covered by Îe,
    since then vl cannot be flushed)" *)

definition Î3 :: "state â value list â state â value list â bool" where
"Î3 s vl s1 vl1 â¡
 â cid.
   PID ââ paperIDs s cid â§ phase s cid â¥ disPH â§
   decsPaper (paper s PID) â  [] â§ decsPaper (paper s1 PID) â  [] â§ eqExcPID2 s s1 â§
   vl = [] â§ vl1 = []"
(* "During or after discussion, values flushed,
    state equality a bit tighter: up to the tail of the decision list (so strict equality on the head,
    which is the only thing a potential author may see);
    the list of decisions also have to be nonempty in order
    for eqExcPID2 to be preserved by transitions" *)

definition Îe :: "state â value list â state â value list â bool" where
"Îe s vl s1 vl1 â¡
 vl â  [] â§
 ((â cid. PID ââ paperIDs s cid â§ phase s cid > disPH)
  â¨
  (â cid. PID ââ paperIDs s cid â§ phase s cid â¥ disPH â§
          Â¬ (â uid. isChair s cid uid â§ pref s uid PID â  Conflict))
 )"

lemma istate_Î1:
assumes B: "B vl vl1"
shows "Î1 istate vl istate vl1"
using B unfolding Î1_def B_def istate_def by auto

lemma unwind_cont_Î1: "unwind_cont Î1 {Î1,Î2,Îe}"
proof(rule, simp)
  let ?Î = "Î»s vl s1 vl1. Î1 s vl s1 vl1 â¨ Î2 s vl s1 vl1 â¨ Îe s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Î1 s vl s1 vl1"
  hence rs: "reach s" and ss1: "s1 = s"
  and vl: "vl â  []" and vl1: "vl1 â  []" and vl_vl1: "last vl1 = last vl"
  and ph_PID: "â cid. PID ââ paperIDs s cid â¹ phase s cid < disPH"
  using reachNT_reach unfolding Î1_def B_def by auto
  note vlvl1 = vl vl1 vl_vl1
  show "iaction ?Î s vl s1 vl1 â¨
        ((vl = [] â¶ vl1 = []) â§ reaction ?Î s vl s1 vl1)" (is "?iact â¨ (_ â§ ?react)")
  proof-
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"  let ?trn1 = "Trans s1 a ou s'"
      assume step: "step s a = (ou, s')" and T: "Â¬ T ?trn" and c: "consume ?trn vl vl'"
      have Ï: "Â¬ Ï ?trn"
      proof (cases a)
        case (UUact x3)
        then show ?thesis
          using step ph_PID
          by (cases x3; fastforce simp: uu_defs)
      qed auto
      hence vl': "vl' = vl" using c unfolding consume_def by auto
      show "match ?Î s s1 vl1 a ou s' vl' â¨ ignore ?Î s s1 vl1 a ou s' vl'" (is "?match â¨ ?ignore")
      proof-
        have ?match proof
          show "validTrans ?trn1" unfolding ss1 using step by simp
        next
          show "consume ?trn1 vl1 vl1" unfolding consume_def ss1 using Ï by auto
        next
          show "Î³ ?trn = Î³ ?trn1" unfolding ss1 by simp
        next
          assume "Î³ ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
        next
          show "?Î s' vl' s' vl1"
          proof(cases "â cid. PID ââ paperIDs s cid")
            case False note PID = False
            have ph_PID': "â cid. PID ââ paperIDs s' cid â¹ phase s' cid < disPH" using PID step rs
            apply(cases a)
              subgoal for _ x1 apply(cases x1) apply(fastforce simp: c_defs)+ .
              subgoal for _ x2 apply(cases x2) apply(fastforce simp: u_defs)+ .
              subgoal for _ x3 apply(cases x3) apply(fastforce simp: uu_defs)+ .
              by auto
            hence "Î1 s' vl' s' vl1" unfolding Î1_def B_def vl' using ph_PID' vlvl1 by auto
            thus ?thesis by auto
          next
            case True
            then obtain CID where PID: "PID ââ paperIDs s CID" by auto
            hence ph: "phase s CID < disPH" using ph_PID by auto
            have PID': "PID ââ paperIDs s' CID" by (metis PID paperIDs_mono step)
            show ?thesis
            proof(cases "phase s' CID < disPH")
              case True note ph' = True
              hence "Î1 s' vl' s' vl1" unfolding Î1_def B_def vl' using vlvl1 ph' PID'
                by (auto; metis reach_PairI paperIDs_equals rs step)
              thus ?thesis by auto
            next
              case False note ph' = False
              hence ph': "phase s' CID = disPH" using ph PID step rs
              apply(cases a)
                subgoal for x1 apply(cases x1) apply(fastforce simp: c_defs)+ .
                subgoal for x2 apply(cases x2) apply(fastforce simp: u_defs)+ .
                subgoal for x3 apply(cases x3) apply(fastforce simp: uu_defs)+ .
              by auto
              show ?thesis
              proof(cases "âuid. isChair s' CID uid â§ pref s' uid PID â  Conflict")
                case True
                hence "Î2 s' vl' s' vl1" unfolding Î2_def B_def vl' using vlvl1 ph' PID' by auto
                thus ?thesis by auto
              next
                case False
                hence "Îe s' vl' s' vl1" unfolding Îe_def vl' using vlvl1 ph' PID' by auto
                thus ?thesis by auto
              qed
            qed
          qed
        qed
        thus ?thesis by simp
      qed
    qed
    thus ?thesis using vl by auto
  qed
qed

lemma unwind_cont_Î2: "unwind_cont Î2 {Î2,Î3,Îe}"
proof(rule, simp)
  let ?Î = "Î»s vl s1 vl1. Î2 s vl s1 vl1 â¨ Î3 s vl s1 vl1 â¨ Îe s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Î2 s vl s1 vl1"
  then obtain CID uid where uid: "isChair s CID uid" "pref s uid PID â  Conflict"
  and rs: "reach s" and ph: "phase s CID = disPH" (is "?ph = _")
  and PID: "PID ââ paperIDs s CID" and ss1: "eqExcPID s s1"
  and vl: "vl â  []" and vl1: "vl1 â  []" and vl_vl1: "last vl = last vl1"
  using reachNT_reach unfolding Î2_def B_def by auto
  note vlvl1 = vl vl1 vl_vl1
  from vl vl1 obtain v vl' v1 vl1' where vl: "vl = v # vl'" and vl1: "vl1 = v1 # vl1'" by (metis list.exhaust)
  have uid_notin: "uid â UIDs"
  using ph uid reachNT_non_isPC_isChair[OF rsT] PID by fastforce
  show "iaction ?Î s vl s1 vl1 â¨
        ((vl = [] â¶ vl1 = []) â§ reaction ?Î s vl s1 vl1)" (is "?iact â¨ (_ â§ ?react)")
  proof(cases "vl1' = []")
    case False note vl1' = False
    hence vl_vl1': "last vl = last vl1'" using vl_vl1 unfolding vl1 by simp
    have uid1: "isChair s1 CID uid" "pref s1 uid PID â  Conflict" using ss1 uid unfolding eqExcPID_def by auto
    define a1 where "a1 â¡ UUact (uuDec CID uid (pass s uid) PID v1)"
    obtain s1' ou1 where step1: "step s1 a1 = (ou1,s1')" by (metis prod.exhaust)
    let ?trn1 = "Trans s1 a1 ou1 s1'"
    have s1s1': "eqExcPID s1 s1'" using a1_def step1 UUact_uuDec_step_eqExcPID by auto
    have ss1': "eqExcPID s s1'" using eqExcPID_trans[OF ss1 s1s1'] .
    hence many_s1': "PID ââ paperIDs s1' CID" "isChair s1' CID uid"
    "pref s1' uid PID â  Conflict" "phase s1' CID = disPH"
    "pass s1' uid = pass s uid"
    using uid PID ph unfolding eqExcPID_def by auto
    hence more_s1': "uid ââ userIDs s1'" "CID ââ confIDs s1'"
    by (metis paperIDs_confIDs reach_PairI roles_userIDs rs1 step1 many_s1'(1))+
    have f: "f ?trn1 = v1" unfolding a1_def by simp
    have rs1': "reach s1'" using rs1 step1 by (auto intro: reach_PairI)
    have ou1: "ou1 = outOK"
    using step1 uid1 ph unfolding a1_def by (auto simp add: uu_defs many_s1' more_s1')
    have ?iact proof
      show "step s1 a1 = (ou1,s1')" by fact
    next
      show Ï: "Ï ?trn1" using ou1 unfolding a1_def by simp
      thus "consume ?trn1 vl1 vl1'" using f unfolding consume_def vl1 by simp
    next
      show "Â¬ Î³ ?trn1" by (simp add: a1_def uid_notin)
    next
      have "Î2 s vl s1' vl1'" unfolding Î2_def B_def using ph PID ss1' uid vl_vl1' vl1' vl by auto
      thus "?Î s vl s1' vl1'" by simp
    qed
    thus ?thesis by auto
  next
    case True hence vl1: "vl1 = [v1]" unfolding vl1 by simp
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vll'
      let ?trn = "Trans s a ou s'"
      let ?ph' = "phase s' CID"
      assume step: "step s a = (ou, s')" and T: "Â¬ T ?trn" and c: "consume ?trn vl vll'"
      have PID': "PID ââ paperIDs s' CID" using PID rs by (metis paperIDs_mono step)
      have uid': "isChair s' CID uid â§ pref s' uid PID â  Conflict"
      using uid step rs ph PID pref_Conflict_disPH isChair_persistent by auto
      show "match ?Î s s1 vl1 a ou s' vll' â¨ ignore ?Î s s1 vl1 a ou s' vll'" (is "?match â¨ ?ignore")
      proof(cases "Ï ?trn")
        case False note Ï = False
        have vll': "vll' = vl" using c Ï unfolding consume_def by (cases vl) auto
        obtain ou1 and s1' where step1: "step s1 a = (ou1,s1')" by (metis prod.exhaust)
        let ?trn1 = "Trans s1 a ou1 s1'"
        have s's1': "eqExcPID s' s1'" using eqExcPID_step[OF ss1 step] step1 rs rs1 PID ph by auto
        have Ï1: "Â¬ Ï ?trn1" using Ï unfolding eqExcPID_step_Ï[OF ss1 step step1] .
        have ?match proof
          show "validTrans ?trn1" using step1 by simp
        next
          show "consume ?trn1 vl1 vl1" unfolding consume_def using Ï1 by auto
        next
          show "Î³ ?trn = Î³ ?trn1" unfolding ss1 by simp
        next
          assume "Î³ ?trn" thus "g ?trn = g ?trn1"
          using eqExcPID_step_out[OF ss1 step step1 rsT rs1 PID ph] by simp
 (* note that in this setting eqExcPID_step_out needs the additional phase assumption *)
        next
          show "?Î s' vll' s1' vl1"
          proof(cases "?ph' = disPH")
            case True
            hence "Î2 s' vll' s1' vl1" using PID' s's1' uid' vlvl1 unfolding Î2_def B_def vll' by auto
            thus ?thesis by auto
          next
            case False hence "?ph' > disPH" using ph rs step by (metis le_less phase_increases)
            hence "Îe s' vll' s1' vl1" unfolding Îe_def vll' using vlvl1 PID' by auto
            thus ?thesis by auto
          qed
        qed
        thus ?thesis by simp
      next
        case True note Ï = True
        hence vll': "vll' = vl'" using c unfolding vl consume_def by simp
        obtain cid uid p where a: "a = UUact (uuDec cid uid p PID v)" and ou: "ou = outOK"
        using Ï c PID unfolding vl consume_def Ï_def2 vll' by fastforce
        (* hence cid: "cid = CID" using step PID rs by (auto simp add: uu_defs paperIDs_equals) *)
        hence Î³: "Â¬ Î³ ?trn" using step T rsT by (metis T_Ï_Î³ True)
        hence f: "f ?trn = v" using c Ï unfolding consume_def vl by auto
        have s's: "eqExcPID s' s" using eqExcPID_sym[OF Ï_step_eqExcPID[OF Ï step]] .
        have s's1: "eqExcPID s' s1" using eqExcPID_trans[OF s's ss1] .
        have ph': "phase s' CID = disPH" using s's ph unfolding eqExcPID_def by auto
        show ?thesis
        proof(cases "vl' = []")
          case False note vl' = False
          hence vl'_vl1: "last vl' = last vl1" using vl_vl1 unfolding vl by auto
          have ?ignore proof
            show "Â¬ Î³ ?trn" by fact
          next
            show "?Î s' vll' s1 vl1"
            proof(cases "?ph' = disPH")
              case True
              hence "Î2 s' vll' s1 vl1" using s's1 PID' uid' vl' vl1 vl_vl1 unfolding Î2_def B_def vl vll' by auto
              thus ?thesis by auto
            next
              case False hence "?ph' > disPH" using ph rs step by (metis le_less phase_increases)
              hence "Îe s' vll' s1 vl1" unfolding Îe_def vll' using vlvl1 vl' PID' by auto
              thus ?thesis by auto
            qed
          qed
          thus ?thesis by auto
        next
          case True note vl' = True hence vl: "vl = [v]" unfolding vl by simp
(* the transition to Î3: Ï holds and both vl and vl1 are singletons: *)
          hence v1v: "v1 = v" using vl_vl1 unfolding vl1 by simp
          obtain s1' ou1 where step1: "step s1 a = (ou1,s1')" by (metis prod.exhaust)
          let ?trn1 = "Trans s1 a ou1 s1'"
          have Ï1: "Ï ?trn1" using eqExcPID_step_Ï_imp[OF ss1 step step1 Ï] .
          hence ou1: "ou1 = outOK" unfolding Ï_def2 by auto
          have ?match proof
          show "validTrans ?trn1" using step1 by simp
        next
          show "consume ?trn1 vl1 []" unfolding consume_def using Ï1 by (simp add: a vl1 v1v)
        next
          show "Î³ ?trn = Î³ ?trn1" unfolding ss1 by simp
        next
          assume "Î³ ?trn" thus "g ?trn = g ?trn1"
          using eqExcPID_step_out[OF ss1 step step1 rsT rs1 PID ph] by simp
        next
          have "Î3 s' vll' s1' []" unfolding vll' vl' Î3_def
          using PID' ph' eqExcPID_step_Ï_eqExcPID2[OF ss1 step step1 Ï rs rs1 PID] ph
          using step step1 unfolding a by (auto simp: uu_defs ou ou1)
          thus "?Î s' vll' s1' []" by simp
        qed
        thus ?thesis by simp
        qed
      qed
    qed
    thus ?thesis using vl by auto
  qed
qed

lemma unwind_cont_Î3: "unwind_cont Î3 {Î3,Îe}"
proof(rule, simp)
  let ?Î = "Î»s vl s1 vl1. Î3 s vl s1 vl1 â¨ Îe s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Î3 s vl s1 vl1"
  then obtain CID where rs: "reach s" and ph: "phase s CID â¥ disPH" (is "?ph â¥ _")
  and PID: "PID ââ paperIDs s CID"
  and decs: "decsPaper (paper s PID) â  []"  "decsPaper (paper s1 PID) â  []"
  and ss1: "eqExcPID2 s s1" and vl: "vl = []" and vl1: "vl1 = []"
  using reachNT_reach unfolding Î3_def by auto
  show "iaction ?Î s vl s1 vl1 â¨
        ((vl = [] â¶ vl1 = []) â§ reaction ?Î s vl s1 vl1)" (is "?iact â¨ (_ â§ ?react)")
  proof-
    have "?react"
    proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      let ?ph' = "phase s' CID"
      assume step: "step s a = (ou, s')" and T: "Â¬ T ?trn" and c: "consume ?trn vl vl'"
      have PID': "PID ââ paperIDs s' CID" using PID rs by (metis paperIDs_mono step)
      have ph': "phase s' CID â¥ disPH" using ph rs step by (meson dual_order.trans phase_increases)
      show "match ?Î s s1 vl1 a ou s' vl' â¨ ignore ?Î s s1 vl1 a ou s' vl'" (is "?match â¨ ?ignore")
      proof-
        have Ï: "Â¬ Ï ?trn" and vl': "vl' = []" using c unfolding consume_def vl by auto
        obtain ou1 and s1' where step1: "step s1 a = (ou1,s1')" by (metis prod.exhaust)
        let ?trn1 = "Trans s1 a ou1 s1'"
        have s's1': "eqExcPID2 s' s1'" using eqExcPID2_step[OF ss1 step step1] .
        have Ï1: "Â¬ Ï ?trn1" using Ï unfolding eqExcPID2_step_Ï[OF ss1 step step1] .
        have PID1: "PID ââ paperIDs s1 CID" using PID ss1 unfolding eqExcPID2_def by auto
        have decs': "decsPaper (paper s' PID) â  []"  "decsPaper (paper s1' PID) â  []"
        by (metis PID PID1 decs nonempty_decsPaper_persist rs step rs1 step1)+
        have ?match proof
          show "validTrans ?trn1" using step1 by simp
        next
          show "consume ?trn1 vl1 vl1" unfolding consume_def using Ï1 by auto
        next
          show "Î³ ?trn = Î³ ?trn1" unfolding ss1 by simp
        next
          assume "Î³ ?trn" thus "g ?trn = g ?trn1"
          using eqExcPID2_step_out[OF ss1 step step1 rsT rs1 PID ph _ decs] by simp
        next
          have "Î3 s' vl' s1' vl1" using ph' PID' s's1' unfolding Î3_def vl1 vl' by (auto simp: decs')
          thus "?Î s' vl' s1' vl1" by simp
        qed
        thus ?thesis by simp
      qed
    qed
    thus ?thesis using vl1 by simp
  qed
qed

(* Exit arguments: *)
definition K1exit where
"K1exit cid s â¡
 phase s cid â¥ disPH â§ PID ââ paperIDs s cid â§ Â¬ (â uid. isChair s cid uid â§ pref s uid PID â  Conflict)"

lemma invarNT_K1exit: "invarNT (K1exit cid)"
unfolding invarNT_def apply (safe dest!: reachNT_reach)
  subgoal for _ a apply(cases a)
    subgoal for x1 apply(cases x1)
      apply (fastforce simp add: c_defs K1exit_def geq_noPH_confIDs)+ .
    subgoal for x2 apply(cases x2)
            apply (fastforce simp add: u_defs K1exit_def paperIDs_equals)
           apply (fastforce simp add: u_defs K1exit_def paperIDs_equals)
          apply (fastforce simp add: u_defs K1exit_def paperIDs_equals)
         apply (fastforce simp add: u_defs K1exit_def paperIDs_equals)
        apply (fastforce simp add: u_defs K1exit_def paperIDs_equals)
      subgoal for x61 apply(cases "x61 = cid")
         apply (fastforce simp add: u_defs K1exit_def paperIDs_equals)+ .
      apply (fastforce simp add: u_defs K1exit_def paperIDs_equals) .
    subgoal for x3 apply(cases x3) apply (fastforce simp add: uu_defs K1exit_def)+ .
    apply (fastforce simp add: uu_defs K1exit_def)+ .
done

lemma noVal_K1exit: "noVal (K1exit cid) v"
apply(rule noÏ_noVal)
unfolding noÏ_def apply safe
  subgoal for _ a apply(cases a)
        apply (fastforce simp add: c_defs K1exit_def)
       apply (fastforce simp add: c_defs K1exit_def)
    subgoal for x3 apply(cases x3) apply (auto simp add: uu_defs K1exit_def)
      apply (metis paperIDs_equals reachNT_reach) (* safety used *) .
    by auto
done

definition K2exit where
"K2exit cid s â¡ PID ââ paperIDs s cid â§ phase s cid > disPH"

lemma invarNT_K2exit: "invarNT (K2exit cid)"
unfolding invarNT_def apply (safe dest!: reachNT_reach)
  subgoal for _ a apply(cases a)
    subgoal for x1 apply(cases x1)
      apply (fastforce simp add: c_defs K2exit_def geq_noPH_confIDs)+ .
    subgoal for x2 apply(cases x2)
      apply (fastforce simp add: u_defs K2exit_def paperIDs_equals)+ .
    subgoal for x3 apply(cases x3) apply (fastforce simp add: uu_defs K2exit_def)+ .
    apply (fastforce simp add: uu_defs K2exit_def)+ .
done

lemma noVal_K2exit: "noVal (K2exit cid) v"
apply(rule noÏ_noVal)
unfolding noÏ_def apply safe
  subgoal for _ a apply(cases a)
        apply (fastforce simp add: c_defs K2exit_def)
       apply (fastforce simp add: c_defs K2exit_def)
    subgoal for x3 apply(cases x3) apply (auto simp add: uu_defs K2exit_def)
      using paperIDs_equals reachNT_reach apply fastforce (* safety used *) .
  by auto
done

lemma unwind_exit_Îe: "unwind_exit Îe"
proof
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and Îe: "Îe s vl s1 vl1"
  hence vl: "vl â  []" using reachNT_reach unfolding Îe_def by auto
  then obtain CID where "K1exit CID s â¨ K2exit CID s" using Îe unfolding K1exit_def K2exit_def Îe_def by auto
  thus "vl â  [] â§ exit s (hd vl)" apply(simp add: vl)
  by (metis rsT exitI2 invarNT_K1exit noVal_K1exit invarNT_K2exit noVal_K2exit)
qed

theorem secure: secure
apply(rule unwind_decomp3_secure[of Î1 Î2 Îe Î3])
using
istate_Î1
unwind_cont_Î1 unwind_cont_Î2 unwind_cont_Î3
unwind_exit_Îe
by auto


end

Theory Decision_NCPC_Aut

theory Decision_NCPC_Aut
imports "../Observation_Setup" Decision_Value_Setup "Bounded_Deducibility_Security.Compositional_Reasoning"
begin

subsection â¹Confidentiality protection from users who are not PC members or authors of the paperâº

text â¹We verify the following property:

A group of users UIDs learn
nothing about the various updates of a paper's decision
(save for the non-existence of any update)
unless/until one of the following happens:
\begin{itemize}
\item a user in UIDs becomes a PC member in the paper's conference having no conflict with that paper
and the conference moves to the discussion phase,
or
\item a user in UIDs becomes a PC member in the paper's conference or an author of the paper,
and the conference moves to the notification phase
\end{itemize}
âº

fun T :: "(state,act,out) trans â bool" where
"T (Trans _ _ ou s') =
 (â uid â UIDs.
    (â cid. PID ââ paperIDs s' cid â§ isPC s' cid uid â§
            pref s' uid PID â  Conflict â§ phase s' cid â¥ disPH)
    â¨
    (â cid. PID ââ paperIDs s' cid â§ isPC s' cid uid â§ phase s' cid â¥ notifPH)
    â¨
    isAUT s' uid PID â§ (â cid. PID ââ paperIDs s' cid â§ phase s' cid â¥ notifPH)
 )"

declare T.simps [simp del]

definition B :: "value list â value list â bool" where
"B vl vl1 â¡ vl â  []"

interpretation BD_Security_IO where
istate = istate and step = step and
Ï = Ï and f = f and Î³ = Î³ and g = g and T = T and B = B
done

lemma reachNT_non_isPC_isChair:
assumes "reachNT s" and "uid â UIDs"
shows
"(PID ââ paperIDs s cid â§ isPC s cid uid â§ phase s cid â¥ disPH
    â¶ pref s uid PID = Conflict â§ phase s cid < notifPH) â§
 (PID ââ paperIDs s cid â§ isChair s cid uid â§ phase s cid â¥ disPH
     â¶ pref s uid PID = Conflict â§ phase s cid < notifPH) â§
 (isAut s cid uid PID â¶ phase s cid < notifPH)"
  using assms
  apply induct
   apply (auto simp: istate_def)[]
  apply(intro conjI)
  subgoal for trn apply(cases trn, fastforce simp: T.simps)[] .
  subgoal
    using T.simps isChair_isPC[OF reachNT_reach] not_less
      reach_PairI[OF reachNT_reach] validTrans validTrans_Trans_srcOf_actOf_tgtOf
    by (metis (no_types, opaque_lifting) isChair_isPC)
  by (metis T.elims(3) reach.Step[OF reachNT_reach] isAUT_def isAut_paperIDs not_le_imp_less tgtOf_simps)


lemma T_Ï_Î³:
assumes 1: "reachNT s" and 2: "step s a = (ou,s')" "Ï (Trans s a ou s')"
shows "Â¬ Î³ (Trans s a ou s')"
using reachNT_non_isPC_isChair[OF 1] 2 unfolding T.simps Ï_def2
by (force simp add: uu_defs)

(* major *) lemma eqExcPID_step_out:
assumes s's1': "eqExcPID s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and sT: "reachNT s" and s1: "reach s1"
and PID: "PID ââ paperIDs s cid"
and UIDs: "userOfA a â UIDs"
shows "ou = ou1"
proof-
  note Inv = reachNT_non_isPC_isChair[OF sT UIDs]
  note eqs = eqExcPID_imp[OF s's1']
  note eqs' = eqExcPID_imp1[OF s's1']
  note s = reachNT_reach[OF sT]

  note simps[simp] = c_defs u_defs uu_defs r_defs l_defs Paper_dest_conv eqExcPID_def eeqExcPID_def eqExcD
  note * = step step1 eqs eqs' s s1 PID UIDs paperIDs_equals[OF s] Inv

  show ?thesis
  proof (cases a)
    case (Cact x1)
    then show ?thesis using * by (cases x1) auto
  next
    case (Uact x2)
    then show ?thesis using * by (cases x2) auto
  next
    case (UUact x3)
    then show ?thesis using * by (cases x3) auto
  next
    case (Ract x4)
    show ?thesis
    proof (cases x4)
      case (rMyReview x81 x82 x83 x84)
      then show ?thesis using * Ract by (auto simp add: getNthReview_def)
    next
      case (rReviews x91 x92 x93 x94)
      then show ?thesis using * Ract by (clarsimp; metis eqExcPID_imp2 s's1')
    next
      case (rDecs x101 x102 x103 x104)
      then show ?thesis using * Ract by (clarsimp; metis)
    next
      case (rFinalDec x131 x132 x133 x134)
      then show ?thesis using * Ract by (clarsimp; metis Suc_leD Suc_leI not_less_eq_eq)
    qed (use * Ract in auto)
  next
    case (Lact x5)
    then show ?thesis using * by (cases x5; auto; presburger)
  qed
qed


definition Î1 :: "state â value list â state â value list â bool" where
"Î1 s vl s1 vl1 â¡
 (â cid. PID ââ paperIDs s cid â¶ phase s cid < disPH) â§ s = s1 â§ B vl vl1"

definition Î2 :: "state â value list â state â value list â bool" where
"Î2 s vl s1 vl1 â¡
 â cid uid.
   PID ââ paperIDs s cid â§ phase s cid = disPH â§
   isChair s cid uid â§ pref s uid PID â  Conflict â§
   eqExcPID s s1"

definition Î3 :: "state â value list â state â value list â bool" where
"Î3 s vl s1 vl1 â¡
 â cid. PID ââ paperIDs s cid â§ phase s cid > disPH â§ eqExcPID s s1 â§ vl1 = []"

definition Îe :: "state â value list â state â value list â bool" where
"Îe s vl s1 vl1 â¡
 vl â  [] â§
 ((â cid. PID ââ paperIDs s cid â§ phase s cid > disPH)
  â¨
  (â cid. PID ââ paperIDs s cid â§ phase s cid â¥ disPH â§
          Â¬ (â uid. isChair s cid uid â§ pref s uid PID â  Conflict))
 )"

lemma istate_Î1:
assumes B: "B vl vl1"
shows "Î1 istate vl istate vl1"
using B unfolding Î1_def B_def istate_def by auto

lemma unwind_cont_Î1: "unwind_cont Î1 {Î1,Î2,Îe}"
proof(rule, simp)
  let ?Î = "Î»s vl s1 vl1. Î1 s vl s1 vl1 â¨ Î2 s vl s1 vl1 â¨ Îe s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Î1 s vl s1 vl1"
  hence rs: "reach s" and ss1: "s1 = s" and vl: "vl â  []"
  and PID_ph: "â cid. PID ââ paperIDs s cid â¹ phase s cid < disPH"
  using reachNT_reach unfolding Î1_def B_def by auto
  show "iaction ?Î s vl s1 vl1 â¨
        ((vl = [] â¶ vl1 = []) â§ reaction ?Î s vl s1 vl1)" (is "?iact â¨ (_ â§ ?react)")
  proof-
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"  let ?trn1 = "Trans s1 a ou s'"
      assume step: "step s a = (ou, s')" and T: "Â¬ T ?trn" and c: "consume ?trn vl vl'"
      have Ï: "Â¬ Ï ?trn"
      proof (cases a)
        case (UUact x3)
        then show ?thesis
          using step PID_ph
          by (cases x3; fastforce simp: uu_defs)
      qed auto
      hence vl': "vl' = vl" using c unfolding consume_def by auto
      show "match ?Î s s1 vl1 a ou s' vl' â¨ ignore ?Î s s1 vl1 a ou s' vl'" (is "?match â¨ ?ignore")
      proof-
        have ?match proof
          show "validTrans ?trn1" unfolding ss1 using step by simp
        next
          show "consume ?trn1 vl1 vl1" unfolding consume_def ss1 using Ï by auto
        next
          show "Î³ ?trn = Î³ ?trn1" unfolding ss1 by simp
        next
          assume "Î³ ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
        next
          show "?Î s' vl' s' vl1"
          proof(cases "â cid. PID ââ paperIDs s cid")
            case False note PID = False
            have PID_ph': "â cid. PID ââ paperIDs s' cid â¹ phase s' cid < disPH" using PID step rs
              apply(cases a)
              subgoal for _ x1 apply(cases x1) apply(fastforce simp: c_defs)+ .
              subgoal for _ x2 apply(cases x2) apply(fastforce simp: u_defs)+ .
              subgoal for _ x3 apply(cases x3) apply(fastforce simp: uu_defs)+ .
              by auto
            hence "Î1 s' vl' s' vl1" unfolding Î1_def B_def vl' using PID_ph' vl by auto
            thus ?thesis by auto
          next
            case True
            then obtain CID where PID: "PID ââ paperIDs s CID" by auto
            hence ph: "phase s CID < disPH" using PID_ph by auto
            have PID': "PID ââ paperIDs s' CID" by (metis PID paperIDs_mono step)
            show ?thesis
            proof(cases "phase s' CID < disPH")
              case True note ph' = True
              hence "Î1 s' vl' s' vl1" unfolding Î1_def B_def vl' using vl ph' PID' apply auto
              by (metis reach_PairI paperIDs_equals rs step)
              thus ?thesis by auto
            next
              case False note ph' = False
              hence ph': "phase s' CID = disPH" using ph PID step rs
                apply(cases a)
                subgoal for x1 apply(cases x1) apply(fastforce simp: c_defs)+ .
                subgoal for x2 apply(cases x2) apply(fastforce simp: u_defs)+ .
                subgoal for x3 apply(cases x3) apply(fastforce simp: uu_defs)+ .
                by auto
              show ?thesis
              proof(cases "âuid. isChair s' CID uid â§ pref s' uid PID â  Conflict")
                case True
                hence "Î2 s' vl' s' vl1" unfolding Î2_def vl' using vl ph' PID' by auto
                thus ?thesis by auto
              next
                case False
                hence "Îe s' vl' s' vl1" unfolding Îe_def vl' using vl ph' PID' by auto
                thus ?thesis by auto
              qed
            qed
          qed
        qed
        thus ?thesis by simp
      qed
    qed
    thus ?thesis using vl by auto
  qed
qed

lemma unwind_cont_Î2: "unwind_cont Î2 {Î2,Î3,Îe}"
proof(rule, simp)
  let ?Î = "Î»s vl s1 vl1. Î2 s vl s1 vl1 â¨ Î3 s vl s1 vl1 â¨ Îe s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Î2 s vl s1 vl1"
  then obtain CID uid where uid: "isChair s CID uid" "pref s uid PID â  Conflict"
  and rs: "reach s" and ph: "phase s CID = disPH" (is "?ph = _")
  and PID: "PID ââ paperIDs s CID" and ss1: "eqExcPID s s1"
  using reachNT_reach unfolding Î2_def by auto
  hence uid_notin: "uid â UIDs" using ph reachNT_non_isPC_isChair[OF rsT] by force
  show "iaction ?Î s vl s1 vl1 â¨
        ((vl = [] â¶ vl1 = []) â§ reaction ?Î s vl s1 vl1)" (is "?iact â¨ (_ â§ ?react)")
  proof(cases vl1)
    case (Cons v1 vl1') note vl1 = Cons
    have uid1: "isChair s1 CID uid" "pref s1 uid PID â  Conflict" using ss1 uid unfolding eqExcPID_def by auto
    define a1 where "a1 â¡ UUact (uuDec CID uid (pass s uid) PID v1)"
    obtain s1' ou1 where step1: "step s1 a1 = (ou1,s1')" by (metis prod.exhaust)
    let ?trn1 = "Trans s1 a1 ou1 s1'"
    have s1s1': "eqExcPID s1 s1'" using a1_def step1 UUact_uuDec_step_eqExcPID by auto
    have ss1': "eqExcPID s s1'" using eqExcPID_trans[OF ss1 s1s1'] .
    hence many_s1': "PID ââ paperIDs s1' CID" "isChair s1' CID uid"
    "pref s1' uid PID â  Conflict" "phase s1' CID = disPH"
    "pass s1' uid = pass s uid"
    using uid PID ph unfolding eqExcPID_def by auto
    hence more_s1': "uid ââ userIDs s1'" "CID ââ confIDs s1'"
    by (metis paperIDs_confIDs reach_PairI roles_userIDs rs1 step1 many_s1'(1))+
    have f: "f ?trn1 = v1" unfolding a1_def by simp
    have rs1': "reach s1'" using rs1 step1 by (auto intro: reach_PairI)
    have ou1: "ou1 = outOK"
    using step1 uid1 ph unfolding a1_def by (auto simp add: uu_defs many_s1' more_s1')
    have ?iact proof
      show "step s1 a1 = (ou1,s1')" by fact
    next
      show Ï: "Ï ?trn1" using ou1 unfolding a1_def by simp
      thus "consume ?trn1 vl1 vl1'" using f unfolding consume_def vl1 by simp
    next
      show "Â¬ Î³ ?trn1" by (simp add: a1_def uid_notin)
    next
      have "Î2 s vl s1' vl1'" unfolding Î2_def using ph PID ss1' uid by auto
      thus "?Î s vl s1' vl1'" by simp
    qed
    thus ?thesis by auto
  next
    case Nil note vl1 = Nil
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      let ?ph' = "phase s' CID"
      assume step: "step s a = (ou, s')" and T: "Â¬ T ?trn" and c: "consume ?trn vl vl'"
      have PID': "PID ââ paperIDs s' CID" using PID rs by (metis paperIDs_mono step)
      have uid': "isChair s' CID uid â§ pref s' uid PID â  Conflict"
      using uid step rs ph PID pref_Conflict_disPH isChair_persistent by auto
      show "match ?Î s s1 vl1 a ou s' vl' â¨ ignore ?Î s s1 vl1 a ou s' vl'" (is "?match â¨ ?ignore")
      proof(cases "Ï ?trn")
        case False note Ï = False
        have vl: "vl' = vl" using c Ï unfolding consume_def by (cases vl) auto
        obtain ou1 and s1' where step1: "step s1 a = (ou1,s1')" by (metis prod.exhaust)
        let ?trn1 = "Trans s1 a ou1 s1'"
        have s's1': "eqExcPID s' s1'" using eqExcPID_step[OF ss1 step step1] .
        have Ï1: "Â¬ Ï ?trn1" using Ï unfolding eqExcPID_step_Ï[OF ss1 step step1] .
        have ?match proof
          show "validTrans ?trn1" using step1 by simp
        next
          show "consume ?trn1 vl1 vl1" unfolding consume_def using Ï1 by auto
        next
          show "Î³ ?trn = Î³ ?trn1" unfolding ss1 by simp
        next
          assume "Î³ ?trn" thus "g ?trn = g ?trn1"
          using eqExcPID_step_out[OF ss1 step step1 rsT rs1 PID] by simp
        next
          show "?Î s' vl' s1' vl1"
          proof(cases "?ph' = disPH")
            case True
            hence "Î2 s' vl' s1' vl1" using PID' s's1' uid' unfolding Î2_def by auto
            thus ?thesis by auto
          next
            case False hence "?ph' > disPH"
            using ph rs step by (metis le_less phase_increases)
            hence "Î3 s' vl' s1' vl1" using s's1' PID' unfolding Î3_def vl1 by auto
            thus ?thesis by auto
          qed
        qed
        thus ?thesis by simp
      next
        case True note Ï = True
        have s's: "eqExcPID s' s" using eqExcPID_sym[OF Ï_step_eqExcPID[OF Ï step]] .
        have s's1: "eqExcPID s' s1" using eqExcPID_trans[OF s's ss1] .
        have ?ignore proof
          show "Â¬ Î³ ?trn" using T_Ï_Î³ Ï rsT step by auto
        next
          show "?Î s' vl' s1 vl1"
          proof(cases "?ph' = disPH")
            case True
            hence "Î2 s' vl' s1 vl1" using s's1 PID' uid' unfolding Î2_def by auto
            thus ?thesis by auto
          next
            case False hence "?ph' > disPH"
            using ph rs step  by (metis le_less phase_increases)
            hence "Î3 s' vl' s1 vl1" using s's1 PID' unfolding Î3_def vl1 by auto
            thus ?thesis by auto
          qed
        qed
        thus ?thesis by auto
      qed
    qed
    thus ?thesis using vl1 by auto
  qed
qed

lemma unwind_cont_Î3: "unwind_cont Î3 {Î3,Îe}"
proof(rule, simp)
  let ?Î = "Î»s vl s1 vl1. Î3 s vl s1 vl1 â¨ Îe s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and Î3: "Î3 s vl s1 vl1"
  then obtain CID where
  rs: "reach s" and ph: "phase s CID > disPH" (is "?ph > _") and PID: "PID ââ paperIDs s CID"
  and ss1: "eqExcPID s s1" and vl1: "vl1 = []"
  using reachNT_reach unfolding Î3_def by auto
  show "iaction ?Î s vl s1 vl1 â¨
        ((vl = [] â¶ vl1 = []) â§ reaction ?Î s vl s1 vl1)" (is "?iact â¨ (_ â§ ?react)")
  proof-
    have "?react"
    proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      let ?ph' = "phase s' CID"
      assume step: "step s a = (ou, s')" and T: "Â¬ T ?trn" and c: "consume ?trn vl vl'"
      have ph': "?ph' > disPH" using ph step by (metis less_le_trans phase_increases)
      have PID': "PID ââ paperIDs s' CID" using PID step by (metis paperIDs_mono)

      show "match ?Î s s1 vl1 a ou s' vl' â¨ ignore ?Î s s1 vl1 a ou s' vl'" (is "?match â¨ ?ignore")
      proof-
        have Ï: "Â¬ Ï ?trn" using ph step unfolding Ï_def2 apply (auto simp: uu_defs)
        using PID less_not_refl2 paperIDs_equals rs by blast
        have vl: "vl' = vl" using c Ï unfolding consume_def by (cases vl) auto
        obtain ou1 and s1' where step1: "step s1 a = (ou1,s1')" by (metis prod.exhaust)
        let ?trn1 = "Trans s1 a ou1 s1'"
        have s's1': "eqExcPID s' s1'" using eqExcPID_step[OF ss1 step step1] .
        have Ï1: "Â¬ Ï ?trn1" using Ï unfolding eqExcPID_step_Ï[OF ss1 step step1] .
        have ?match proof
          show "validTrans ?trn1" using step1 by simp
        next
          show "consume ?trn1 vl1 vl1" unfolding consume_def using Ï1 by auto
        next
          show "Î³ ?trn = Î³ ?trn1" unfolding ss1 by simp
        next
          assume "Î³ ?trn" thus "g ?trn = g ?trn1"
          using eqExcPID_step_out[OF ss1 step step1 rsT rs1 PID _] ph by simp
        next
          have "Î3 s' vl' s1' vl1" using ph' PID' s's1' unfolding Î3_def vl1 by auto
          thus "?Î s' vl' s1' vl1" by simp
        qed
        thus ?thesis by simp
      qed
    qed
    thus ?thesis using vl1 by simp
  qed
qed

(* Exit arguments: *)
definition K1exit where
"K1exit cid s â¡
 (PID ââ paperIDs s cid â§ phase s cid â¥ disPH â§ Â¬ (â uid. isChair s cid uid â§ pref s uid PID â  Conflict))"

lemma invarNT_K1exit: "invarNT (K1exit cid)"
unfolding invarNT_def apply (safe dest!: reachNT_reach)
  subgoal for _ a apply(cases a)
    subgoal for x1 apply(cases x1)
      apply (fastforce simp add: c_defs K1exit_def geq_noPH_confIDs)+ .
    subgoal for x2 apply(cases x2)
            apply (fastforce simp add: u_defs K1exit_def paperIDs_equals)
           apply (fastforce simp add: u_defs K1exit_def paperIDs_equals)
          apply (fastforce simp add: u_defs K1exit_def paperIDs_equals)
         apply (fastforce simp add: u_defs K1exit_def paperIDs_equals)
        apply (fastforce simp add: u_defs K1exit_def paperIDs_equals)
      subgoal for x61 apply(cases "x61 = cid")
        apply (fastforce simp add: u_defs K1exit_def paperIDs_equals)+ .
      apply (fastforce simp add: u_defs K1exit_def paperIDs_equals) .
    subgoal for x3 apply(cases x3) apply (fastforce simp add: uu_defs K1exit_def)+ .
     apply (fastforce simp add: u_defs K1exit_def paperIDs_equals)+ .
  done

lemma noVal_K1exit: "noVal (K1exit cid) v"
apply(rule noÏ_noVal)
unfolding noÏ_def apply safe
  subgoal for _ a apply(cases a)
        apply (fastforce simp add: c_defs K1exit_def)
       apply (fastforce simp add: c_defs K1exit_def)
    subgoal for x3 apply(cases x3) apply (auto simp add: uu_defs K1exit_def)
      apply(metis paperIDs_equals reachNT_reach) .
    by auto
  done

definition K2exit where
"K2exit cid s â¡ PID ââ paperIDs s cid â§ phase s cid > disPH"

lemma invarNT_K2exit: "invarNT (K2exit cid)"
unfolding invarNT_def apply (safe dest!: reachNT_reach)
  subgoal for _ a apply(cases a)
    subgoal for x1 apply(cases x1)
      apply (fastforce simp add: c_defs K2exit_def geq_noPH_confIDs)+ .
    subgoal for x2 apply(cases x2)
      apply (fastforce simp add: u_defs K2exit_def paperIDs_equals)+ .
    subgoal for x3 apply(cases x3)
         apply (fastforce simp add: uu_defs K2exit_def)+ .
    by auto
  done

lemma noVal_K2exit: "noVal (K2exit cid) v"
apply(rule noÏ_noVal)
unfolding noÏ_def apply safe
  subgoal for _ a apply(cases a)
        apply (fastforce simp add: c_defs K2exit_def)
       apply (fastforce simp add: c_defs K2exit_def)
    subgoal for x3 apply(cases x3)
      apply (auto simp add: uu_defs K2exit_def)
      apply (metis less_not_refl paperIDs_equals reachNT_reach) .
    by auto
  done

lemma unwind_exit_Îe: "unwind_exit Îe"
proof
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and Îe: "Îe s vl s1 vl1"
  hence vl: "vl â  []" using reachNT_reach unfolding Îe_def by auto
  then obtain CID where "K1exit CID s â¨ K2exit CID s" using Îe unfolding K1exit_def K2exit_def Îe_def by auto
  thus "vl â  [] â§ exit s (hd vl)" apply(simp add: vl)
  by (metis rsT exitI2 invarNT_K1exit noVal_K1exit invarNT_K2exit noVal_K2exit)
qed

theorem secure: secure
apply(rule unwind_decomp3_secure[of Î1 Î2 Îe Î3])
using
istate_Î1
unwind_cont_Î1 unwind_cont_Î2 unwind_cont_Î3
unwind_exit_Îe
by auto

end

itle>

Theory Reviewer_Assignment_Value_Setup

(* The value setup for reviewer confidentiality *)
theory Reviewer_Assignment_Value_Setup
  imports Reviewer_Assignment_Intro
begin


subsection â¹Preliminariesâº

declare updates_commute_paper[simp]

consts PID :: paperID

(* Equality of two role lists everywhere except on their PID reviewer roles *)
definition eqExcRLR :: "role list â role list â bool" where
"eqExcRLR rl rl1 â¡ [r â rl . Â¬ isRevRoleFor PID r] = [r â rl1 . Â¬ isRevRoleFor PID r]"

lemma eqExcRLR_set:
assumes 1: "eqExcRLR rl rl1" and 2: "Â¬ isRevRoleFor PID r"
shows "r ââ rl â· r ââ rl1"
proof-
  have "set ([rârl . Â¬ isRevRoleFor PID r]) = set ([rârl1 . Â¬ isRevRoleFor PID r])"
  using 1 unfolding eqExcRLR_def by auto
  thus ?thesis using 2 unfolding set_filter by auto
qed

lemmas eqExcRLR = eqExcRLR_def

lemma eqExcRLR_eq[simp,intro!]: "eqExcRLR rl rl"
unfolding eqExcRLR by auto

lemma eqExcRLR_sym:
assumes "eqExcRLR rl rl1"
shows "eqExcRLR rl1 rl"
using assms unfolding eqExcRLR by auto

lemma eqExcRLR_trans:
assumes "eqExcRLR rl rl1" and "eqExcRLR rl1 rl2"
shows "eqExcRLR rl rl2"
using assms unfolding eqExcRLR by auto

lemma eqExcRLR_imp:
assumes s: "reach s" and pid: "pid â  PID" and
1: "eqExcRLR (roles s cid uid) (roles s1 cid uid)"
shows
"isRevNth s cid uid pid = isRevNth s1 cid uid pid â§
 isRev s cid uid pid = isRev s1 cid uid pid â§
 getRevRole s cid uid pid = getRevRole s1 cid uid pid â§
 getReviewIndex s cid uid pid = getReviewIndex s1 cid uid pid" (is "?A â§ ?B â§ ?C â§ ?D")
proof(intro conjI)
  show A: ?A
    apply(rule ext)
    using 1 by (metis eqExcRLR_set isRevRoleFor.simps(1) pid)
  show B: ?B using A unfolding isRev_def2 by auto
  show C: ?C
    apply(cases "isRev s cid uid pid")
    subgoal by (metis A B getRevRole_Some_Rev_isRevNth isRevNth_equals isRev_getRevRole2 s)
    by (metis B Bex_set_list_ex find_None_iff getRevRole_def isRev_def)
  show D: ?D unfolding getReviewIndex_def using C by auto
qed

lemma eqExcRLR_imp2:
assumes "eqExcRLR (roles s cid uid) (roles s1 cid uid)"
shows
"isPC s cid uid = isPC s1 cid uid â§
 isChair s cid uid = isChair s1 cid uid â§
 isAut s cid uid = isAut s1 cid uid"
by (metis (opaque_lifting, no_types) assms eqExcRLR_set isRevRoleFor.simps)

(* fixme: move where belong *)
lemma filter_eq_imp:
assumes "â x. P x â¹ Q x"
and "filter Q xs = filter Q ys"
shows "filter P xs = filter P ys"
using assms filter_filter
proof-
  have "filter P xs = filter P (filter Q xs)"
  unfolding filter_filter using assms by metis
  also have "... = filter P (filter Q ys)" using assms by simp
  also have "... = filter P ys" unfolding filter_filter using assms by metis
  finally show ?thesis .
qed

lemma arg_cong3: "a = a1 â¹ b = b1 â¹ c = c1 â¹ h a b c = h a1 b1 c1"
by auto

lemmas map_concat_cong1 = arg_cong[where f = concat, OF arg_cong2[where f = map, OF _ refl]]
lemmas If_cong1 = arg_cong3[where h = If, OF _ refl refl]

lemma diff_cong1: "a = a1 â¹ (a â  b) = (a1 â  b)" by auto

lemma isRev_pref_notConflict:
assumes "reach s" and "isRev s cid uid pid"
shows "pref s uid pid â  Conflict"
by (metis assms pref_Conflict_isRev)

lemma isRev_pref_notConflict_isPC:
assumes "reach s" and "isRev s cid uid pid"
shows "pref s uid pid â  Conflict â§ isPC s cid uid"
by (metis assms(1) assms(2) isRev_isPC isRev_pref_notConflict)

lemma eqExcRLR_imp_isRevRole_imp:
assumes "eqExcRLR rl rl1"
shows "[râ rl. Â¬ isRevRole r] = [râ rl1 . Â¬ isRevRole r]"
using assms filter_eq_imp unfolding eqExcRLR_def
by (metis isRevRole.simps(1) isRevRoleFor.elims(2))

lemma notIsPC_eqExLRL_roles_eq:
assumes s: "reach s" and s1: "reach s1" and PID: "PID ââ paperIDs s cid"
and pc: "Â¬ isPC s cid uid"
and eq: "eqExcRLR (roles s cid uid) (roles (s1::state) cid uid)"
shows "roles s cid uid = roles s1 cid uid"
proof-
  have "Â¬ isPC s1 cid uid" using pc eqExcRLR_imp2[OF eq] by auto
  hence "Â¬ isRev s cid uid PID â§ Â¬ isRev s1 cid uid PID" using pc s s1 PID
  by (metis isRev_pref_notConflict_isPC)
  thus ?thesis using eq unfolding eqExcRLR_def
  by (metis Bex_set_list_ex filter_id_conv isRev_def)
qed

lemma foo1: "P a â¹ [râList.insert a l . P r] = (if aâset l then filter P l else a#filter P l)"
  by (metis filter.simps(2) in_set_insert not_in_set_insert)

lemma foo2: "â¦eqExcRLR rl rl'; Â¬ isRevRoleFor PID xâ§ â¹ eqExcRLR (List.insert x rl) (List.insert x rl')"
  unfolding eqExcRLR_def
  apply (auto simp: foo1) []
  apply (metis eqExcRLR_def eqExcRLR_set isRevRoleFor.simps)+
  done

lemma foo3:
  assumes "eqExcRLR rl rl'" "isRevRoleFor PID x"
  shows "eqExcRLR (List.insert x rl) (rl')"
  and "eqExcRLR (rl) (List.insert x rl')"
  using assms
  unfolding eqExcRLR_def
  by (auto simp: List.insert_def)


text â¹The notion of two states being equal everywhere except on the reviewer roles for PID:âº

definition eqExcPID :: "state â state â bool" where
"eqExcPID s s1 â¡
 confIDs s = confIDs s1 â§ conf s = conf s1 â§
 userIDs s = userIDs s1 â§ pass s = pass s1 â§ user s = user s1
 â§
 (â cid uid. eqExcRLR (roles s cid uid) (roles s1 cid uid))
 â§
 paperIDs s = paperIDs s1
 â§
 paper s = paper s1
 â§
 pref s = pref s1 â§
 voronkov s = voronkov s1 â§
 news s = news s1 â§ phase s = phase s1"

lemma eqExcPID_eq[simp,intro!]: "eqExcPID s s"
unfolding eqExcPID_def by auto

lemma eqExcPID_sym:
assumes "eqExcPID s s1" shows "eqExcPID s1 s"
using assms eqExcRLR_sym unfolding eqExcPID_def by auto

lemma eqExcPID_trans:
assumes "eqExcPID s s1" and "eqExcPID s1 s2" shows "eqExcPID s s2"
using assms eqExcRLR_trans unfolding eqExcPID_def by metis

(* Implications from eqExcPID, including w.r.t. auxiliary operations: *)
lemma eqExcPID_imp:
"eqExcPID s s1 â¹
 confIDs s = confIDs s1 â§ conf s = conf s1 â§
 userIDs s = userIDs s1 â§ pass s = pass s1 â§ user s = user s1
 â§
 eqExcRLR (roles s cid uid) (roles s1 cid uid)
 â§
 paperIDs s = paperIDs s1
 â§
 paper s = paper s1
 â§
 pref s = pref s1 â§
 voronkov s = voronkov s1 â§
 news s = news s1 â§ phase s = phase s1 â§
 getAllPaperIDs s = getAllPaperIDs s1"
unfolding eqExcPID_def eqExcRLR_def getAllPaperIDs_def by auto

(* does not work well with simp: *)
lemma eqExcPID_imp':
assumes s: "reach s" and ss1: "eqExcPID s s1" and pid: "pid â  PID â¨ PID â  pid"
shows
"isRev s cid uid pid = isRev s1 cid uid pid â§
 getRevRole s cid uid pid = getRevRole s1 cid uid pid â§
 getReviewIndex s cid uid pid = getReviewIndex s1 cid uid pid"
proof-
  have 1: "eqExcRLR (roles s cid uid) (roles s1 cid uid)"
  using eqExcPID_imp[OF ss1] by auto
  show ?thesis proof (intro conjI)
    show 3: "isRev s cid uid pid = isRev s1 cid uid pid"
    by (metis "1" eqExcRLR_imp pid s)
    show 4: "getRevRole s cid uid pid = getRevRole s1 cid uid pid"
    by (metis "1" eqExcRLR_imp pid s)
    show "getReviewIndex s cid uid pid = getReviewIndex s1 cid uid pid"
    unfolding getReviewIndex_def using 4 by auto
  qed
qed

lemma eqExcPID_imp1:
"eqExcPID s s1 â¹ pid â  PID â¨ PID â  pid â¹
    getNthReview s pid n = getNthReview s1 pid n"
unfolding eqExcPID_def getNthReview_def
by auto

lemma eqExcPID_imp2:
assumes "reach s" and "eqExcPID s s1" and "pid â  PID â¨ PID â  pid"
shows "getReviewersReviews s cid pid = getReviewersReviews s1 cid pid"
proof-
  have
  "(Î»uID. if isRev s cid uID pid then [(uID, getNthReview s pid (getReviewIndex s cid uID pid))] else []) =
   (Î»uID. if isRev s1 cid uID pid then [(uID, getNthReview s1 pid (getReviewIndex s1 cid uID pid))] else [])"
  apply(rule ext)
  using assms using assms by (auto simp add: eqExcPID_imp' eqExcPID_imp1)
  thus ?thesis unfolding getReviewersReviews_def using assms by (simp add: eqExcPID_imp)
qed

lemma eqExcPID_imp3:
"reach s â¹ eqExcPID s s1 â¹ pid â  PID â¨ PID â  pid
 â¹
 getNthReview s pid = getNthReview s1 pid"
unfolding eqExcPID_def apply auto
apply (rule ext) by (metis getNthReview_def)

lemma eqExcPID_cong[simp, intro]:
"â uu1 uu2. eqExcPID s s1 â¹ uu1 = uu2 â¹ eqExcPID (s â¦confIDs := uu1â¦) (s1 â¦confIDs := uu2â¦)"
"â uu1 uu2. eqExcPID s s1 â¹ uu1 = uu2 â¹ eqExcPID (s â¦conf := uu1â¦) (s1 â¦conf := uu2â¦)"

"â uu1 uu2. eqExcPID s s1 â¹ uu1 = uu2 â¹ eqExcPID (s â¦userIDs := uu1â¦) (s1 â¦userIDs := uu2â¦)"
"â uu1 uu2. eqExcPID s s1 â¹ uu1 = uu2 â¹ eqExcPID (s â¦pass := uu1â¦) (s1 â¦pass := uu2â¦)"
"â uu1 uu2. eqExcPID s s1 â¹ uu1 = uu2 â¹ eqExcPID (s â¦user := uu1â¦) (s1 â¦user := uu2â¦)"
"â uu1 uu2. eqExcPID s s1 â¹ uu1 = uu2 â¹ eqExcPID (s â¦roles := uu1â¦) (s1 â¦roles := uu2â¦)"

"â uu1 uu2. eqExcPID s s1 â¹ uu1 = uu2 â¹ eqExcPID (s â¦paperIDs := uu1â¦) (s1 â¦paperIDs := uu2â¦)"
"â uu1 uu2. eqExcPID s s1 â¹ uu1 = uu2 â¹ eqExcPID (s â¦paper := uu1â¦) (s1 â¦paper := uu2â¦)"

"â uu1 uu2. eqExcPID s s1 â¹ uu1 = uu2 â¹ eqExcPID (s â¦pref := uu1â¦) (s1 â¦pref := uu2â¦)"
"â uu1 uu2. eqExcPID s s1 â¹ uu1 = uu2 â¹ eqExcPID (s â¦voronkov := uu1â¦) (s1 â¦voronkov := uu2â¦)"
"â uu1 uu2. eqExcPID s s1 â¹ uu1 = uu2 â¹ eqExcPID (s â¦news := uu1â¦) (s1 â¦news := uu2â¦)"
"â uu1 uu2. eqExcPID s s1 â¹ uu1 = uu2 â¹ eqExcPID (s â¦phase := uu1â¦) (s1 â¦phase := uu2â¦)"

unfolding eqExcPID_def by auto

text â¹A slightly weaker state equivalence that allows differences in the reviews of paper \<^term>â¹PIDâº.
It is used for the confidentiality property that doesn't cover the authors of that paper in the
notification phase (when the authors will learn the contents of the reviews).âº

(* Equality of two papers everywhere except on their reviews *)
fun eqExcR :: "paper â paper â bool" where
"eqExcR (Paper name info ct reviews dis decs)
        (Paper name1 info1 ct1 reviews1 dis1 decs1) =
 (name = name1 â§ info = info1 â§ ct = ct1 â§ dis = dis1 â§ decs = decs1)"

lemma eqExcR:
"eqExcR pap pap1 =
 (titlePaper pap = titlePaper pap1 â§ abstractPaper pap = abstractPaper pap1 â§
  contentPaper pap = contentPaper pap1 â§
  disPaper pap = disPaper pap1 â§ decsPaper pap = decsPaper pap1)"
by(cases pap, cases pap1, auto)

lemma eqExcR_eq[simp,intro!]: "eqExcR pap pap"
unfolding eqExcR by auto

lemma eqExcR_sym:
assumes "eqExcR pap pap1"
shows "eqExcR pap1 pap"
using assms unfolding eqExcR by auto

lemma eqExcR_trans:
assumes "eqExcR pap pap1" and "eqExcR pap1 pap2"
shows "eqExcR pap pap2"
using assms unfolding eqExcR by auto

(* Auxiliary notion:  *)
definition eeqExcPID where
"eeqExcPID paps paps1 â¡
 â pid. if pid = PID then eqExcR (paps pid) (paps1 pid) else paps pid = paps1 pid"

lemma eeqExcPID_eeq[simp,intro!]: "eeqExcPID s s"
unfolding eeqExcPID_def by auto

lemma eeqExcPID_sym:
assumes "eeqExcPID s s1" shows "eeqExcPID s1 s"
using assms eqExcR_sym unfolding eeqExcPID_def by auto

lemma eeqExcPID_trans:
assumes "eeqExcPID s s1" and "eeqExcPID s1 s2" shows "eeqExcPID s s2"
using assms eqExcR_trans unfolding eeqExcPID_def by simp blast

lemma eeqExcPID_imp:
"eeqExcPID paps paps1 â¹ eqExcR (paps PID) (paps1 PID)"
"â¦eeqExcPID paps paps1; pid â  PIDâ§ â¹ paps pid = paps1 pid"
unfolding eeqExcPID_def by auto

lemma eeqExcPID_cong:
assumes "eeqExcPID paps paps1"
and "pid = PID â¹ eqExcR uu uu1"
and "pid â  PID â¹ uu = uu1"
shows "eeqExcPID (paps (pid := uu)) (paps1(pid := uu1))"
using assms unfolding eeqExcPID_def by auto

lemma eeqExcPID_RDD:
"eeqExcPID paps paps1 â¹
 titlePaper (paps PID) = titlePaper (paps1 PID) â§
 abstractPaper (paps PID) = abstractPaper (paps1 PID) â§
 contentPaper (paps PID) = contentPaper (paps1 PID) â§
 disPaper (paps PID) = disPaper (paps1 PID) â§
 decsPaper (paps PID) = decsPaper (paps1 PID)"
using eeqExcPID_def unfolding eqExcR by auto

(* The notion of two states being equal everywhere except on the the reviews of PID
   and on the reviewer roles for PID *)
definition eqExcPID2 :: "state â state â bool" where
"eqExcPID2 s s1 â¡
 confIDs s = confIDs s1 â§ conf s = conf s1 â§
 userIDs s = userIDs s1 â§ pass s = pass s1 â§ user s = user s1
 â§
 (â cid uid. eqExcRLR (roles s cid uid) (roles s1 cid uid))
 â§
 paperIDs s = paperIDs s1
 â§
 eeqExcPID (paper s) (paper s1)
 â§
 pref s = pref s1 â§
 voronkov s = voronkov s1 â§
 news s = news s1 â§ phase s = phase s1"

lemma eqExcPID2_eq[simp,intro!]: "eqExcPID2 s s"
unfolding eqExcPID2_def by auto

lemma eqExcPID2_sym:
assumes "eqExcPID2 s s1" shows "eqExcPID2 s1 s"
using assms eeqExcPID_sym eqExcRLR_sym unfolding eqExcPID2_def by auto

lemma eqExcPID2_trans:
assumes "eqExcPID2 s s1" and "eqExcPID2 s1 s2" shows "eqExcPID2 s s2"
using assms eeqExcPID_trans eqExcRLR_trans unfolding eqExcPID2_def by metis

(* Implications from eqExcPID2, including w.r.t. auxiliary operations: *)
lemma eqExcPID2_imp:
"eqExcPID2 s s1 â¹
 confIDs s = confIDs s1 â§ conf s = conf s1 â§
 userIDs s = userIDs s1 â§ pass s = pass s1 â§ user s = user s1
 â§
 eqExcRLR (roles s cid uid) (roles s1 cid uid)
 â§
 paperIDs s = paperIDs s1
 â§
 eeqExcPID (paper s) (paper s1)
 â§
 pref s = pref s1 â§
 voronkov s = voronkov s1 â§
 news s = news s1 â§ phase s = phase s1 â§

 getAllPaperIDs s = getAllPaperIDs s1"
unfolding eqExcPID2_def eqExcRLR_def getAllPaperIDs_def by auto


lemma eeqExcPID_imp2:
assumes pid: "pid â  PID" and
1: "eeqExcPID (paper s) (paper s1)"
shows
"reviewsPaper (paper s pid) = reviewsPaper (paper s1 pid)"
by (metis "1" eeqExcPID_imp(2) pid)

(* does not work well with simp: *)
lemma eqExcPID2_imp':
assumes s: "reach s" and ss1: "eqExcPID2 s s1" and pid: "pid â  PID â¨ PID â  pid"
shows
"isRev s cid uid pid = isRev s1 cid uid pid â§
 getRevRole s cid uid pid = getRevRole s1 cid uid pid â§
 getReviewIndex s cid uid pid = getReviewIndex s1 cid uid pid â§
 reviewsPaper (paper s pid) = reviewsPaper (paper s1 pid)"
proof-
  have 1: "eqExcRLR (roles s cid uid) (roles s1 cid uid)"
  and 2: "eeqExcPID (paper s) (paper s1)"
  using eqExcPID2_imp[OF ss1] by auto
  show ?thesis proof (intro conjI)
    show 3: "isRev s cid uid pid = isRev s1 cid uid pid"
    by (metis "1" eqExcRLR_imp pid s)
    show 4: "getRevRole s cid uid pid = getRevRole s1 cid uid pid"
    by (metis "1" eqExcRLR_imp pid s)
    show "getReviewIndex s cid uid pid = getReviewIndex s1 cid uid pid"
    unfolding getReviewIndex_def using 4 by auto
    show "reviewsPaper (paper s pid) = reviewsPaper (paper s1 pid)"
    using pid 2 unfolding eeqExcPID_def by auto
  qed
qed

lemma eqExcPID2_imp1:
"eqExcPID2 s s1 â¹ eqExcR (paper s pid) (paper s1 pid)"
"eqExcPID2 s s1 â¹ pid â  PID â¨ PID â  pid â¹
    paper s pid = paper s1 pid â§
    getNthReview s pid n = getNthReview s1 pid n"
unfolding eqExcPID2_def eeqExcPID_def getNthReview_def
apply auto by (metis eqExcR_eq)

lemma eqExcPID2_imp2:
assumes "reach s" and "eqExcPID2 s s1" and "pid â  PID â¨ PID â  pid"
shows "getReviewersReviews s cid pid = getReviewersReviews s1 cid pid"
proof-
  have
  "(Î»uID. if isRev s cid uID pid then [(uID, getNthReview s pid (getReviewIndex s cid uID pid))] else []) =
   (Î»uID. if isRev s1 cid uID pid then [(uID, getNthReview s1 pid (getReviewIndex s1 cid uID pid))] else [])"
  apply(rule ext)
  using assms using assms by (auto simp add: eqExcPID2_imp' eqExcPID2_imp1)
  thus ?thesis unfolding getReviewersReviews_def using assms by (simp add: eqExcPID2_imp)
qed

lemma eqExcPID2_imp3:
"reach s â¹ eqExcPID2 s s1 â¹ pid â  PID â¨ PID â  pid
 â¹
 getNthReview s pid = getNthReview s1 pid"
unfolding eqExcPID2_def apply auto
apply (rule ext) by (metis eeqExcPID_imp getNthReview_def)

lemma eqExcPID2_RDD:
"eqExcPID2 s s1 â¹
 titlePaper (paper s PID) = titlePaper (paper s1 PID) â§
 abstractPaper (paper s PID) = abstractPaper (paper s1 PID) â§
 contentPaper (paper s PID) = contentPaper (paper s1 PID) â§
 disPaper (paper s PID) = disPaper (paper s1 PID) â§
 decsPaper (paper s PID) = decsPaper (paper s1 PID)"
using eqExcPID2_imp eeqExcPID_RDD by auto

lemma eqExcPID2_cong[simp, intro]:
"â uu1 uu2. eqExcPID2 s s1 â¹ uu1 = uu2 â¹ eqExcPID2 (s â¦confIDs := uu1â¦) (s1 â¦confIDs := uu2â¦)"
"â uu1 uu2. eqExcPID2 s s1 â¹ uu1 = uu2 â¹ eqExcPID2 (s â¦conf := uu1â¦) (s1 â¦conf := uu2â¦)"

"â uu1 uu2. eqExcPID2 s s1 â¹ uu1 = uu2 â¹ eqExcPID2 (s â¦userIDs := uu1â¦) (s1 â¦userIDs := uu2â¦)"
"â uu1 uu2. eqExcPID2 s s1 â¹ uu1 = uu2 â¹ eqExcPID2 (s â¦pass := uu1â¦) (s1 â¦pass := uu2â¦)"
"â uu1 uu2. eqExcPID2 s s1 â¹ uu1 = uu2 â¹ eqExcPID2 (s â¦user := uu1â¦) (s1 â¦user := uu2â¦)"
"â uu1 uu2. eqExcPID2 s s1 â¹ uu1 = uu2 â¹ eqExcPID2 (s â¦roles := uu1â¦) (s1 â¦roles := uu2â¦)"

"â uu1 uu2. eqExcPID2 s s1 â¹ uu1 = uu2 â¹ eqExcPID2 (s â¦paperIDs := uu1â¦) (s1 â¦paperIDs := uu2â¦)"
"â uu1 uu2. eqExcPID2 s s1 â¹ eeqExcPID uu1 uu2 â¹ eqExcPID2 (s â¦paper := uu1â¦) (s1 â¦paper := uu2â¦)"

"â uu1 uu2. eqExcPID2 s s1 â¹ uu1 = uu2 â¹ eqExcPID2 (s â¦pref := uu1â¦) (s1 â¦pref := uu2â¦)"
"â uu1 uu2. eqExcPID2 s s1 â¹ uu1 = uu2 â¹ eqExcPID2 (s â¦voronkov := uu1â¦) (s1 â¦voronkov := uu2â¦)"
"â uu1 uu2. eqExcPID2 s s1 â¹ uu1 = uu2 â¹ eqExcPID2 (s â¦news := uu1â¦) (s1 â¦news := uu2â¦)"
"â uu1 uu2. eqExcPID2 s s1 â¹ uu1 = uu2 â¹ eqExcPID2 (s â¦phase := uu1â¦) (s1 â¦phase := uu2â¦)"

unfolding eqExcPID2_def by auto

lemma eqExcPID2_Paper:
assumes s's1': "eqExcPID2 s s1"
and "paper s pid = Paper title abstract content reviews dis decs"
and "paper s1 pid = Paper title1 abstract1 content1 reviews1 dis1 decs1"
shows "title = title1 â§ abstract = abstract1 â§ content = content1 â§ dis = dis1 â§ decs = decs1"
using assms unfolding eqExcPID2_def apply (auto simp: eqExcR eeqExcPID_def)
by (metis titlePaper.simps abstractPaper.simps contentPaper.simps disPaper.simps decsPaper.simps)+


lemma cReview_step_eqExcPID2:
assumes a:
"a = Cact (cReview cid uid p PID uid')"
and "step s a = (ou,s')"
shows "eqExcPID2 s s'"
using assms unfolding eqExcPID2_def eeqExcPID_def eqExcRLR_def
apply (auto simp: c_defs)
unfolding List.insert_def by (smt filter.simps(2) isRevRoleFor.simps(1))


subsection â¹Value Setupâº

type_synonym "value" = "userID Ã userID set"

fun Ï :: "(state,act,out) trans â bool" where
"Ï (Trans _ (Cact (cReview cid uid p pid uid')) ou _) =
 (pid = PID â§ ou = outOK)"
|
"Ï _ = False"

fun f :: "(state,act,out) trans â value" where
"f (Trans s (Cact (cReview cid uid p pid uid')) _ s') =
 (uid', {uid'. isPC s cid uid' â§ pref s uid' PID â  Conflict})"

lemma Ï_def2:
"Ï (Trans s a ou s') =
 (ou = outOK â§
 (â cid uid p uid'. a = Cact (cReview cid uid p PID uid')))"
apply(cases a, simp_all) subgoal for x1 by (cases x1, auto) .


fun Ï :: "act â bool" where
"Ï (Uact (uReview cid uid p pid n rc)) = (pid = PID)"
|
"Ï (UUact (uuReview cid uid p pid n rc)) = (pid = PID)"
|
"Ï _ = False"

lemma Ï_def2:
"Ï a =
 (â cid uid p n rc. a = Uact (uReview cid uid p PID n rc) â¨
                    a = UUact (uuReview cid uid p PID n rc))"
apply(cases a, simp_all)
  subgoal for x2 apply (cases x2, auto) .
  subgoal for x3 by (cases x3, auto) .

lemma eqExcPID_step_Ï_imp:
assumes s: "reach s" and ss1: "eqExcPID s s1"
(* new compared to the other properties: *)
and PID: "PID ââ paperIDs s cid" and ph: "phase s cid > revPH"
(* end new *)
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and Ï: "Â¬ Ï (Trans s a ou s')"
shows "Â¬ Ï (Trans s1 a ou1 s1')"
using assms unfolding Ï_def2 apply (auto simp add: c_defs eqExcPID_imp)
unfolding eqExcPID_def
apply(metis eqExcRLR_imp[OF s] eqExcRLR_imp2)
apply(metis eqExcRLR_imp[OF s] eqExcRLR_imp2)
using eqExcRLR_imp[OF s] PID by (metis less_not_refl paperIDs_equals)

lemma eqExcPID_step_Ï:
assumes "reach s" and "reach s1" and ss1: "eqExcPID s s1"
(* new compared to the other properties: *)
and PID: "PID ââ paperIDs s cid" and ph: "phase s cid > revPH"
(* end new *)
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
shows "Ï (Trans s a ou s') = Ï (Trans s1 a ou1 s1')"
proof-
  have "PID ââ paperIDs s1 cid â§ phase s1 cid > revPH"
  using eqExcPID_imp[OF ss1] PID ph by auto
  thus ?thesis by (metis eqExcPID_step_Ï_imp eqExcPID_sym assms)
qed

(* new lemma compared to the other properties: *)
lemma non_eqExcPID_step_Ï_imp:
assumes s: "reach s" and ss1: "eqExcPID s s1"
and PID: "PID ââ paperIDs s cid" and ou: "ou â  outErr"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and Ï: "Â¬ Ï (Trans s a ou s')"
shows "Â¬ Ï (Trans s1 a ou1 s1')"
using assms unfolding Ï_def2 by (auto simp add: c_defs eqExcPID_imp)

(* major *) lemma eqExcPID_step:
assumes s: "reach s" and s1: "reach s1"
and ss1: "eqExcPID s s1"
and step: "step s a = (ou,s')"
and step1: "step s1 a = (ou1,s1')"
and PID: "PID ââ paperIDs s cid"
and ou_ph: "ou â  outErr â¨ phase s cid > revPH"
and Ï: "Â¬ Ï (Trans s a ou s')" and Ï: "Â¬ Ï a"
shows "eqExcPID s' s1'"
proof -
  have s': "reach s'" by (metis reach_PairI s step)
  note eqs = eqExcPID_imp[OF ss1]
  note eqs' = eqExcPID_imp1[OF ss1]

  note eqss = eqExcPID_imp'[OF s ss1]

  note simps[simp] = c_defs u_defs uu_defs r_defs l_defs Paper_dest_conv eqExcPID_def
  note simps2[simp] = eqExcRLR_imp2[where s=s and ?s1.0 = s1'] eqExcRLR_imp2[where s=s' and ?s1.0 = s1]
       eqExcRLR_set[of "(roles s cid uid)" "(roles s1' cid uid)" for uid cid]
       eqExcRLR_set[of "(roles s' cid uid)" "(roles s1 cid uid)" for uid cid]
       foo2 foo3 eqExcRLR_imp[OF s, where ?s1.0=s1'] eqExcRLR_imp[OF s', where ?s1.0=s1]

  note * = step step1 eqs eqs' Ï Ï PID ou_ph

  then show ?thesis
  proof (cases a)
    case (Cact x1)
    with * show ?thesis
    proof (cases x1)
      case (cReview x81 x82 x83 x84 x85)
      with Cact * show ?thesis
        by clarsimp (metis less_irrefl_nat paperIDs_equals s1 simps2(9))
    qed auto
  next
    case (Uact x2)
    with * show ?thesis
    proof (cases x2)
      case (uReview x71 x72 x73 x74 x75 x76)
      with Uact * show ?thesis
        by (clarsimp simp del: simps2) auto
    qed auto
  next
    case (UUact x3)
    with * show ?thesis
    proof (cases x3)
      case (uuReview x31 x32 x33 x34 x35 x36)
      with UUact * show ?thesis
        by (clarsimp simp del: simps2) auto
    qed auto
  qed auto
qed


lemma Ï_step_eqExcPID2:
assumes Ï: "Ï (Trans s a ou s')"
and s: "step s a = (ou,s')"
shows "eqExcPID2 s s'"
using Ï cReview_step_eqExcPID2[OF _ s] unfolding Ï_def2 by blast

(* major *) lemma eqExcPID2_step:
assumes s: "reach s"
and ss1: "eqExcPID2 s s1"
and step: "step s a = (ou,s')"
and step1: "step s1 a = (ou1,s1')"
and PID: "PID ââ paperIDs s cid" and ph: "phase s cid â¥ revPH"
and Ï: "Â¬ Ï (Trans s a ou s')"
shows "eqExcPID2 s' s1'"
proof -
  have s': "reach s'" by (metis reach_PairI s step)
  note eqs = eqExcPID2_imp[OF ss1]
  (* note eqss = eqExcPID2_imp'[OF s ss1] *)
  note eqs' = eqExcPID2_imp1[OF ss1]

  note eqss = eqExcPID2_imp'[OF s ss1]

  note simps[simp] = c_defs u_defs uu_defs r_defs l_defs
          Paper_dest_conv
          eqExcPID2_def eeqExcPID_def
          eqExcR
  note simps2[simp] = eqExcRLR_imp2[where s=s and ?s1.0 = s1'] eqExcRLR_imp2[where s=s' and ?s1.0 = s1]
      eqExcRLR_set[of "(roles s cid uid)" "(roles s1' cid uid)" for cid uid]
      eqExcRLR_set[of "(roles s' cid uid)" "(roles s1 cid uid)" for cid uid]
      foo2 foo3 eqExcRLR_imp[OF s, where ?s1.0=s1'] eqExcRLR_imp[OF s', where ?s1.0=s1]
  note * = step step1 eqs eqs' ph PID Ï

  then show ?thesis
  proof (cases a)
    case (Cact x1)
    with * show ?thesis
    proof (cases x1)
      case (cReview x81 x82 x83 x84 x85)
      with Cact * show ?thesis
        by clarsimp (metis simps2(9))
    qed auto
  next
    case (Uact x2)
    with * show ?thesis
    proof (cases x2)
      case (uReview x71 x72 x73 x74 x75 x76)
      with Uact * show ?thesis
        by (clarsimp simp del: simps2) auto
    qed auto
  next
    case (UUact x3)
    with * show ?thesis
    proof (cases x3)
      case (uuReview x31 x32 x33 x34 x35 x36)
      with UUact * show ?thesis
        by (clarsimp simp del: simps2) auto
    qed auto
  next
    case (Lact x5)
    with * show ?thesis by (cases x5; auto)
  qed auto
qed

lemma eqExcPID2_step_Ï_imp:
assumes s: "reach s" and ss1: "eqExcPID2 s s1"
(* new compared to the other properties: *)
and PID: "PID ââ paperIDs s cid" and ph: "phase s cid > revPH"
(* end new *)
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and Ï: "Â¬ Ï (Trans s a ou s')"
shows "Â¬ Ï (Trans s1 a ou1 s1')"
using assms unfolding Ï_def2 apply (auto simp add: c_defs eqExcPID2_imp)
unfolding eqExcPID2_def
apply(metis eqExcRLR_imp[OF s] eqExcRLR_imp2)
apply(metis eqExcRLR_imp[OF s] eqExcRLR_imp2)
using eqExcRLR_imp[OF s] PID by (metis less_not_refl paperIDs_equals)

lemma eqExcPID2_step_Ï:
assumes "reach s" and "reach s1" and ss1: "eqExcPID2 s s1"
(* new compared to the other properties: *)
and PID: "PID ââ paperIDs s cid" and ph: "phase s cid > revPH"
(* end new *)
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
shows "Ï (Trans s a ou s') = Ï (Trans s1 a ou1 s1')"
proof-
  have "PID ââ paperIDs s1 cid â§ phase s1 cid > revPH"
  using eqExcPID2_imp[OF ss1] PID ph by auto
  thus ?thesis by (metis eqExcPID2_step_Ï_imp eqExcPID2_sym assms)
qed

(* new lemma compared to the other properties: *)
lemma non_eqExcPID2_step_Ï_imp:
assumes s: "reach s" and ss1: "eqExcPID2 s s1"
and PID: "PID ââ paperIDs s cid" and ou: "ou â  outErr"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and Ï: "Â¬ Ï (Trans s a ou s')"
shows "Â¬ Ï (Trans s1 a ou1 s1')"
using assms unfolding Ï_def2 by (auto simp add: c_defs eqExcPID2_imp)




end

/head>

Theory Reviewer_Assignment_NCPC

theory Reviewer_Assignment_NCPC
imports "../Observation_Setup" Reviewer_Assignment_Value_Setup "Bounded_Deducibility_Security.Compositional_Reasoning"
begin

subsection â¹Confidentiality protection from non-PC-membersâº

text â¹We verify the following property:

\ \\
A group of users UIDs learn
nothing about the reviewers assigned to a paper PID
except for their number and the fact that they are PC members having no conflict
with that paper
unless/until the user becomes a PC member in the paper's conference
having no conflict with that paper and the conference moves to the reviewing phase.

\ \\
âº


fun T :: "(state,act,out) trans â bool" where
"T (Trans _ _ ou s') =
 (â uid â UIDs. â cid.
    PID ââ paperIDs s' cid â§ isPC s' cid uid â§ pref s' uid PID â  Conflict â§ phase s' cid â¥ revPH)"

term isAUT

declare T.simps [simp del]

(*
The explanation of what this bound says is similar to that of
the bound in Reviewer_Assignment_NCPC_Aut, just that the value vl'
is additionally assumed to have the same length as vl (i.e.,
using the notations from that explanation, m = n).
*)

definition B :: "value list â value list â bool" where
"B vl vl1 â¡
 vl â  [] â§
 length vl = length vl1 â§
 distinct (map fst vl1) â§ fst ` (set vl1) â snd (hd vl) â§ snd ` (set vl1) = {snd (hd vl)}"

interpretation BD_Security_IO where
istate = istate and step = step and
Ï = Ï and f = f and Î³ = Î³ and g = g and T = T and B = B
done

lemma reachNT_non_isPC_isChair:
assumes "reachNT s" and "uid â UIDs"
shows
"(PID ââ paperIDs s cid â§ isPC s cid uid â¶
    pref s uid PID = Conflict â¨ phase s cid < revPH) â§
 (PID ââ paperIDs s cid â§ isChair s cid uid â¶
    pref s uid PID = Conflict â¨ phase s cid < revPH)"
  using assms
  apply induct
  subgoal by (auto simp: istate_def)
  subgoal apply(intro conjI)
     apply (metis T.simps not_le_imp_less trans.collapse)
    by (metis T.simps isChair_isPC not_le_imp_less reachNT.Step reachNT_reach trans.collapse)
  done

lemma T_Ï_Î³:
assumes 1: "reachNT s" and 2: "step s a = (ou,s')" "Ï (Trans s a ou s')"
shows "Â¬ Î³ (Trans s a ou s')"
using reachNT_non_isPC_isChair[OF 1] 2 unfolding T.simps Ï_def2
by (fastforce simp: c_defs isRev_imp_isRevNth_getReviewIndex)

lemma T_Ï_Î³_stronger:
assumes s: "reach s" and 0: "PID ââ paperIDs s cid"
and 2: "step s a = (ou,s')" "Ï (Trans s a ou s')"
and 1: "â uid â UIDs. isChair s cid uid â¶ pref s uid PID = Conflict â¨ phase s cid < revPH"
shows "Â¬ Î³ (Trans s a ou s')"
proof-
  have "Â¬ (â uid â UIDs. â cid. PID ââ paperIDs s cid â§
  isChair s cid uid â§ pref s uid PID â  Conflict â§ phase s cid â¥ revPH)"
  using 0 1 s by (metis not_le paperIDs_equals)
  thus ?thesis using assms unfolding T.simps Ï_def2 by (force simp add: c_defs)
qed

lemma T_Ï_Î³_1:
assumes s: "reachNT s" and s1: "reach s1" and PID: "PID ââ paperIDs s cid"
and ss1: "eqExcPID s s1"
and step1: "step s1 a = (ou1,s1')" and Ï1: "Ï (Trans s1 a ou1 s1')"
and Ï: "Â¬ Ï (Trans s a ou s')"
shows "Â¬ Î³ (Trans s1 a ou1 s1')"
proof-
  have "â uid â UIDs. isChair s cid uid â¶ pref s uid PID = Conflict â¨ phase s cid < revPH"
  using reachNT_non_isPC_isChair[OF s] PID by auto
  hence 1: "â uid â UIDs. isChair s1 cid uid â¶ pref s1 uid PID = Conflict â¨ phase s1 cid < revPH"
  using ss1 unfolding eqExcPID_def using eqExcRLR_imp2 by fastforce
  have PID1: "PID ââ paperIDs s1 cid" using PID ss1 eqExcPID_imp by auto
  show ?thesis apply(rule T_Ï_Î³_stronger[OF s1 PID1 step1 Ï1]) using 1 by auto
qed

lemma notIsPCorConflict_eqExcPID_roles_eq:
assumes s: "reach s" and s1: "reach s1" and PID: "PID ââ paperIDs s cid"
and pc: "Â¬ isPC s cid uid â¨ pref s uid PID = Conflict"
and eeq: "eqExcPID s s1"
shows "roles s cid uid = roles s1 cid uid"
proof-
  have eq: "eqExcRLR (roles s cid uid) (roles s1 cid uid)"
  using eeq unfolding eqExcPID_def by auto
  have "Â¬ isPC s1 cid uid â¨ pref s1 uid PID = Conflict"
  using pc eqExcPID_imp[OF eeq] eqExcRLR_imp2[OF eq] by auto
  hence "Â¬ isRev s cid uid PID â§ Â¬ isRev s1 cid uid PID" using pc s s1 PID
  by (metis isRev_pref_notConflict_isPC)
  thus ?thesis using eq unfolding eqExcRLR_def
  by (metis Bex_set_list_ex filter_id_conv isRev_def)
qed

lemma notInPaperIDs_eqExcPID_roles_eq:
assumes s: "reach s" and s1: "reach s1" and PID: "Â¬ PID ââ paperIDs s cid"
and eq: "eqExcPID s s1"
shows "roles s cid uid = roles s1 cid uid"
proof-
  have "Â¬ PID ââ paperIDs s1 cid" using PID eq unfolding eqExcPID_def by auto
  hence "Â¬ isRev s cid uid PID â§ Â¬ isRev s1 cid uid PID" using s s1 PID by (metis isRev_paperIDs)
  thus ?thesis using eq unfolding eqExcPID_def eqExcRLR_def
  by (metis Bex_set_list_ex filter_True isRev_def)
qed

(* major *) lemma eqExcPID_step_out:
assumes ss1: "eqExcPID s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and sT: "reachNT s" and s1: "reach s1"
and PID: "PID ââ paperIDs s cid" and ph: "phase s cid â¥ revPH"
and Ï: "Â¬ Ï (Trans s a ou s')" and Ï1: "Â¬ Ï (Trans s1 a ou1 s1')"  and Ï: "Â¬ Ï a"
and UIDs: "userOfA a â UIDs"
shows "ou = ou1"
proof-
  note s = reachNT_reach[OF sT]
  have s': "reach s'" and s1': "reach s1'" by (metis reach_PairI s s1 step step1)+
  have s's1': "eqExcPID s' s1'"
  using Ï Ï Ï1 eqExcPID_step eqExcPID_sym s s1 ss1 step step1 step_outErr_eq
  by (metis PID isAut_paperIDs notInPaperIDs_eqExcPID_roles_eq paperID_ex_userID1 paperID_ex_userID_def)
  have s1's': "eqExcPID s1' s'" by (metis eqExcPID_sym s's1')
  have s': "reach s'" by (metis reach_PairI s step)
  have ph1: "phase s1 cid â¥ revPH" using ph ss1 unfolding eqExcPID_def by auto
  have ph': "phase s' cid â¥ revPH" and ph1': "phase s1' cid â¥ revPH"
  using ph ph1 by (metis dual_order.trans phase_increases step step1)+
  note Inv = reachNT_non_isPC_isChair[OF sT UIDs]
  note eqs = eqExcPID_imp[OF ss1]
  note eqs' = eqExcPID_imp1[OF ss1]

  note simps[simp] = c_defs u_defs uu_defs r_defs l_defs Paper_dest_conv eqExcPID_def
  note simps2[simp] = eqExcRLR_imp[of s _ _ _ s1, OF s] eqExcRLR_imp[of s' _ _ _ s1']
                eqExcRLR_imp[of s _ _ _ s1'] eqExcRLR_imp[of s' _ _ _ s1]
      eqExcRLR_imp2[of s _ _ s1] eqExcRLR_imp2[of s' _ _ s1']
                eqExcRLR_imp2[of s _ _ s1'] eqExcRLR_imp2[of s' _ _ s1]
      eqExcRLR_set[of "(roles s cid uid)" "(roles s1 cid uid)" for cid uid]
      eqExcRLR_set[of "(roles s cid uid)" "(roles s1' cid uid)" for cid uid]
      eqExcRLR_set[of "(roles s' cid uid)" "(roles s1 cid uid)" for cid uid]
      eqExcRLR_set[of "(roles s' cid uid)" "(roles s1' cid uid)" for cid uid]
      foo2 foo3
      eqExcRLR_imp_isRevRole_imp

  {fix cid uid p pid assume "a = Ract (rMyReview cid uid p pid)"
   hence ?thesis
   using step step1 eqs eqs' s s1 UIDs PID Ï Ï1 Ï paperIDs_equals[OF s] Inv
   apply (auto simp add: isRev_getRevRole getRevRole_Some)[]
   apply (metis eqExcPID_imp' isRev_isPC not_less option.inject pref_Conflict_isRev role.distinct role.inject s1's'
                isRev_isPC not_less pref_Conflict_isRev simps2(1) simps2(8) isRev_getRevRole getRevRole_Some)+
   done
  } note this[simp]

  have ?thesis
    using step step1 eqs eqs' s s1 UIDs PID Ï Ï1 Ï
    paperIDs_equals[OF s] Inv
    apply(cases a, simp_all only:)
      subgoal for x1 apply(cases x1)
        apply auto[] apply auto[] apply auto[] apply auto[]
        apply auto[] apply auto[] apply auto[] apply auto[] .
      subgoal for x2 apply(cases x2)
        apply auto[] apply auto[] apply auto[] apply auto[]
        apply auto[] apply auto[] apply auto[] .
      subgoal for x3 apply(cases x3)
        apply auto[] apply auto[] apply auto[] apply auto[] .
      subgoal for x4 apply(cases x4)
        apply auto[] apply auto[] apply auto[] apply auto[]
        apply auto[] apply auto[] apply auto[] apply auto[]
        apply clarsimp apply (metis eqExcPID_imp2 not_less ph' s's1')
        apply auto[] apply auto[] apply auto[] apply auto[]
        apply auto[] .
     subgoal for x5 apply(cases x5)
        apply auto[] apply auto[] apply auto[]
        apply clarsimp apply (metis (opaque_lifting) empty_iff list.set(1) notInPaperIDs_eqExcPID_roles_eq notIsPCorConflict_eqExcPID_roles_eq s's1' s1's')
        apply auto[] apply auto[] apply auto[] apply auto[]
        apply auto[] apply auto[]
        apply clarsimp apply (metis Suc_leI filter_cong isRev_pref_notConflict_isPC not_less_eq_eq simps2(2))
        apply clarsimp apply (metis not_less simps2(1)) .
     done

  note * = step step1 eqs eqs' s s1 UIDs PID Ï Ï1 Ï paperIDs_equals[OF s] Inv

  show ?thesis
  proof (cases a)
    case (Cact x1)
    with * show ?thesis by (cases x1; auto)
  next
    case (Uact x2)
    with * show ?thesis by (cases x2; auto)
  next
    case (UUact x3)
    with * show ?thesis by (cases x3; auto)
  next
    case (Ract x4)
    with * show ?thesis
    proof (cases x4)
      case (rReviews x91 x92 x93 x94)
      with Ract * show ?thesis
        by clarsimp (metis eqExcPID_imp2 not_less ph' s's1')
    qed auto
  next
    case (Lact x5)
    with * show ?thesis
    proof (cases x5)
      case (lMyConfs x41 x42)
      with Lact * show ?thesis
        by clarsimp (metis (opaque_lifting) empty_iff list.set(1) notInPaperIDs_eqExcPID_roles_eq notIsPCorConflict_eqExcPID_roles_eq s's1' s1's')
    next
      case (lMyAssignedPapers x111 x112 x113)
      with Lact * show ?thesis
        by clarsimp (metis Suc_leI filter_cong isRev_pref_notConflict_isPC not_less_eq_eq simps2(2))
    next
      case (lAssignedReviewers x121 x122 x123 x124)
      with Lact * show ?thesis
        by clarsimp (metis not_less simps2(1))
    qed auto
  qed
qed

lemma eqExcPID_step_Ï_eqExcPID_out:
assumes s: "reach s" and s1: "reach s1"
and a: "a = Cact (cReview cid uid p PID uid')"
and a1: "a1 = Cact (cReview cid uid p PID uid1')"
and ss1: "eqExcPID s s1" and step: "step s a = (outOK,s')"
and pc: "isPC s cid uid1' â§ pref s uid1' PID â  Conflict"
and rv1: "Â¬ isRev s1 cid uid1' PID" and step1: "step s1 a1 = (ou1,s1')"
shows "eqExcPID s' s1' â§ ou1 = outOK"
proof-
  have s': "reach s'" and s1': "reach s1'" by (metis reach_PairI s s1 step step1)+
  have c: "isChair s cid uid â§ pref s uid PID â  Conflict â§
   phase s cid = revPH â§ pass s uid = p â§
   PID ââ paperIDs s cid â§ cid ââ confIDs s"
  using step unfolding a by (auto simp: c_defs)
  hence c1: "isChair s1 cid uid â§ pref s1 uid PID â  Conflict â§
    phase s1 cid = revPH â§ pass s1 uid = p â§
   PID ââ paperIDs s1 cid â§ cid ââ confIDs s1"
  and pc1: "isPC s1 cid uid1' â§ pref s1 uid1' PID â  Conflict"
  using pc ss1 unfolding eqExcPID_def using eqExcRLR_imp2 by metis+

  note simps[simp] = c_defs u_defs uu_defs r_defs l_defs Paper_dest_conv eqExcPID_def
  note simps2[simp] = eqExcRLR_imp[of s _ _ _ s1, OF s] eqExcRLR_imp[of s' _ _ _ s1']
                eqExcRLR_imp[of s _ _ _ s1'] eqExcRLR_imp[of s' _ _ _ s1]
      eqExcRLR_imp2[of s _ _ s1] eqExcRLR_imp2[of s' _ _ s1']
                eqExcRLR_imp2[of s _ _ s1'] eqExcRLR_imp2[of s' _ _ s1]
      eqExcRLR_set[of "(roles s cid uid)" "(roles s1 cid uid)" for cid uid]
      eqExcRLR_set[of "(roles s cid uid)" "(roles s1' cid uid)" for cid uid]
      eqExcRLR_set[of "(roles s' cid uid)" "(roles s1 cid uid)" for cid uid]
      eqExcRLR_set[of "(roles s' cid uid)" "(roles s1' cid uid)" for cid uid]
      foo2 foo3
      eqExcRLR_imp_isRevRole_imp

  show ?thesis
  using pc1 c1 ss1 step step1 c c1 pc rv1 unfolding eqExcPID_def a a1
  using roles_userIDs s1' by force
qed

lemma eqExcPID_ex_isNthReview:
assumes s: "reach s" and s1: "reach s1" and e: "eqExcPID s s1"
and i: "isRevNth s cid uid PID n"
shows "â uid1. isRevNth s1 cid uid1 PID n"
proof-
  have PID: "PID ââ paperIDs s cid" by (metis i isRevNth_paperIDs s)
  have "n < length (reviewsPaper (paper s PID))" using s i by (metis isRevNth_less_length)
  hence "PID ââ paperIDs s1 cid â§ n < length (reviewsPaper (paper s1 PID))"
  using e PID unfolding eqExcPID_def by auto
  thus ?thesis using s1 by (metis reviews_compact)
qed

lemma eqExcPID_step_Ï1:
assumes s: "reach s" and s1: "reach s1"
and a: "a = Uact (uReview cid uid p PID n rc)"
and ss1: "eqExcPID s s1" and step: "step s a = (outOK,s')"
shows
"â s1' uid1 p.
   isRevNth s1 cid uid1 PID n â§
   step s1 (Uact (uReview cid uid1 p PID n rc)) = (outOK,s1') â§
   eqExcPID s' s1'"
proof-
  have s': "reach s'" by (metis reach_PairI s step)
  have c: "isRevNth s cid uid PID n â§ phase s cid = revPH â§ PID ââ paperIDs s cid â§ cid ââ confIDs s"
  using step unfolding a apply (auto simp: u_defs) by (metis isRev_imp_isRevNth_getReviewIndex)
  obtain uid1 where rv1: "isRevNth s1 cid uid1 PID n" using s s1 ss1 by (metis c eqExcPID_ex_isNthReview)
  let ?p = "pass s1 uid1"
  define a1 where a1: "a1 â¡ Uact (uReview cid uid1 (pass s1 uid1) PID n rc)"
  obtain ou1 s1' where step1: "step s1 a1 = (ou1,s1')" by (metis surj_pair)
  have s1': "reach s1'" by (metis reach_PairI s1 step1)
  have c1: "phase s1 cid = revPH â§ PID ââ paperIDs s1 cid â§ cid ââ confIDs s1"
  using ss1 c unfolding eqExcPID_def using eqExcRLR_imp2 by auto
  show ?thesis
  apply(intro exI[of _ s1'] exI[of _ uid1] exI[of _ ?p])
  using rv1 c1 ss1 step step1 c c1 rv1 unfolding eqExcPID_def a a1
  using isRevNth_getReviewIndex isRev_def2 roles_userIDs s1'
  by ((auto
          simp: u_defs
          simp: Paper_dest_conv
          simp: eqExcPID_def
      ))
qed

lemma eqExcPID_step_Ï2:
assumes s: "reach s" and s1: "reach s1"
and a: "a = UUact (uuReview cid uid p PID n rc)"
and ss1: "eqExcPID s s1" and step: "step s a = (outOK,s')"
shows
"â s1' uid1 p.
   isRevNth s1 cid uid1 PID n â§
   step s1 (UUact (uuReview cid uid1 p PID n rc)) = (outOK,s1') â§
   eqExcPID s' s1'"
proof-
  have s': "reach s'" by (metis reach_PairI s step)
  have c: "isRevNth s cid uid PID n â§ phase s cid = disPH â§ PID ââ paperIDs s cid â§ cid ââ confIDs s"
  using step unfolding a apply (auto simp: uu_defs) by (metis isRev_imp_isRevNth_getReviewIndex)
  obtain uid1 where rv1: "isRevNth s1 cid uid1 PID n" using s s1 ss1 by (metis c eqExcPID_ex_isNthReview)
  let ?p = "pass s1 uid1"
  define a1 where  a1: "a1 â¡ UUact (uuReview cid uid1 (pass s1 uid1) PID n rc)"
  obtain ou1 s1' where step1: "step s1 a1 = (ou1,s1')" by (metis surj_pair)
  have s1': "reach s1'" by (metis reach_PairI s1 step1)
  have c1: "phase s1 cid = disPH â§ PID ââ paperIDs s1 cid â§ cid ââ confIDs s1"
  using ss1 c unfolding eqExcPID_def using eqExcRLR_imp2 by auto
  show ?thesis
  apply(intro exI[of _ s1'] exI[of _ uid1] exI[of _ ?p])
  using rv1 c1 ss1 step step1 c c1 rv1 unfolding eqExcPID_def a a1
  using isRevNth_getReviewIndex isRev_def2 roles_userIDs s1'
  by ((force
          simp: uu_defs
          simp: Paper_dest_conv
          simp: eqExcPID_def
      ))
qed


definition Î1 :: "state â value list â state â value list â bool" where
"Î1 s vl s1 vl1 â¡
 (â cid. PID ââ paperIDs s cid â¶ phase s cid < revPH) â§ s = s1
 â§ B vl vl1"

definition Î2 :: "state â value list â state â value list â bool" where
"Î2 s vl s1 vl1 â¡
 â cid uid.
   PID ââ paperIDs s cid â§ phase s cid = revPH â§
   isChair s cid uid â§ pref s uid PID â  Conflict â§
   eqExcPID s s1 â§
   length vl = length vl1 â§
   distinct (map fst vl1) â§
   fst ` (set vl1) â {uid'. isPC s cid uid' â§ pref s uid' PID â  Conflict} â§
   fst ` (set vl1) â© {uid'. isRev s1 cid uid' PID} = {} â§
   snd ` (set vl1) â {{uid'. isPC s cid uid' â§ pref s uid' PID â  Conflict}}"

definition Î3 :: "state â value list â state â value list â bool" where
"Î3 s vl s1 vl1 â¡
 â cid. PID ââ paperIDs s cid â§ phase s cid > revPH â§ eqExcPID s s1 â§ vl1 = []"

definition Îe :: "state â value list â state â value list â bool" where
"Îe s vl s1 vl1 â¡
 vl â  [] â§
 (
  (â cid. PID ââ paperIDs s cid â§ phase s cid â¥ revPH â§
          Â¬ (â uid. isChair s cid uid â§ pref s uid PID â  Conflict))
  â¨
  (â cid. PID ââ paperIDs s cid â§ phase s cid â¥ revPH â§
          snd (hd vl) â  {uid'. isPC s cid uid' â§ pref s uid' PID â  Conflict})
  â¨
  (â cid. PID ââ paperIDs s cid â§ phase s cid > revPH)
 )"

lemma istate_Î1:
assumes B: "B vl vl1"
shows "Î1 istate vl istate vl1"
using B unfolding Î1_def B_def istate_def by auto

lemma unwind_cont_Î1: "unwind_cont Î1 {Î1,Î2,Îe}"
proof(rule, simp)
  let ?Î = "Î»s vl s1 vl1. Î1 s vl s1 vl1 â¨ Î2 s vl s1 vl1 â¨ Îe s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Î1 s vl s1 vl1"
  hence rs: "reach s" and ss1: "s1 = s" and B: "B vl vl1"
  and l: "length vl = length vl1"
  and c_d: "distinct (map fst vl1) â§ fst ` (set vl1) â snd (hd vl) â§ snd ` (set vl1) = {snd (hd vl)}"
  and vl: "vl â  []"
  and PID_ph: "â cid. PID ââ paperIDs s cid â¹ phase s cid < revPH"
  using reachNT_reach unfolding Î1_def B_def by auto
  have rv: "â cid. Â¬ (â uid'. isRev s cid uid' PID)" using rs PID_ph
  by (metis isRev_geq_revPH isRev_paperIDs less_Suc_eq_le not_less_eq_eq)
  show "iaction ?Î s vl s1 vl1 â¨
        ((vl = [] â¶ vl1 = []) â§ reaction ?Î s vl s1 vl1)" (is "?iact â¨ (_ â§ ?react)")
  proof-
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"  let ?trn1 = "Trans s1 a ou s'"
      assume step: "step s a = (ou, s')" and T: "Â¬ T ?trn" and c: "consume ?trn vl vl'"
      have Ï: "Â¬ Ï ?trn"
        apply(cases a)
        subgoal for x1 apply(cases x1) using step PID_ph by (fastforce simp: c_defs)+
        by simp_all
      hence vl': "vl' = vl" using c unfolding consume_def by auto
      show "match ?Î s s1 vl1 a ou s' vl' â¨ ignore ?Î s s1 vl1 a ou s' vl'" (is "?match â¨ ?ignore")
      proof-
        have ?match proof
          show "validTrans ?trn1" unfolding ss1 using step by simp
        next
          show "consume ?trn1 vl1 vl1" unfolding consume_def ss1 using Ï by auto
        next
          show "Î³ ?trn = Î³ ?trn1" unfolding ss1 by simp
        next
          assume "Î³ ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
        next
          show "?Î s' vl' s' vl1"
          proof(cases "â cid. PID ââ paperIDs s cid")
            case False note PID = False
            have PID_ph': "â cid. PID ââ paperIDs s' cid â¹ phase s' cid < revPH" using PID step rs
            apply(cases a)
              subgoal for _ x1 apply(cases x1) apply(fastforce simp: c_defs)+ .
              subgoal for _ x2 apply(cases x2) apply(fastforce simp: u_defs)+ .
              subgoal for _ x3 apply(cases x3) apply(fastforce simp: uu_defs)+ .
              by auto
            hence "Î1 s' vl' s' vl1" unfolding Î1_def B_def vl' using PID_ph' c_d vl l by auto
            thus ?thesis by auto
          next
            case True
            then obtain CID where PID: "PID ââ paperIDs s CID" by auto
            hence ph: "phase s CID < revPH" using PID_ph by auto
            have PID': "PID ââ paperIDs s' CID" by (metis PID paperIDs_mono step)
            show ?thesis
            proof(cases "phase s' CID < revPH")
              case True note ph' = True
              hence "Î1 s' vl' s' vl1" unfolding Î1_def B_def vl' using vl c_d ph' PID' l apply auto
              by (metis reach_PairI paperIDs_equals rs step)
              thus ?thesis by auto
            next
              case False
              hence ph_rv': "phase s' CID = revPH â§ Â¬ (â uid'. isRev s' CID uid' PID)"
              using ph PID step rs rv
              apply(cases a)
                subgoal for x1 apply(cases x1) apply(fastforce simp: c_defs)+ .
                subgoal for x2 apply(cases x2) apply(fastforce simp: u_defs isRev_def2)+ .
                subgoal for x3 apply(cases x3) apply(fastforce simp: uu_defs)+ .
                by auto
              show ?thesis
              proof(cases "(â uid. isChair s' CID uid â§ pref s' uid PID â  Conflict) â§
                           snd (hd vl) = {uid'. isPC s' CID uid' â§ pref s' uid' PID â  Conflict}")
                case True
                hence "Î2 s' vl' s' vl1"
                unfolding Î2_def B_def vl' using c_d ph_rv' PID' l by auto
                thus ?thesis by auto
              next
                case False
                hence "Îe s' vl' s' vl1"
                unfolding Îe_def vl' using vl c_d ph_rv' PID' l by auto
                thus ?thesis by auto
              qed
            qed
          qed
        qed
        thus ?thesis by simp
      qed
    qed
    thus ?thesis using vl by auto
  qed
qed

lemma not_Ï_isRev_isPC_persists:
assumes "reach s"
"PID ââ paperIDs s cid" and "Â¬ Ï (Trans s a ou s')"
and "step s a = (ou,s')"
shows "isRev s' cid uid PID  = isRev s cid uid PID â§ isPC s' cid uid = isPC s cid uid"
  using assms apply(cases a)
  subgoal for x1 apply(cases x1) apply(auto simp: c_defs isRev_def2 roles_confIDs paperIDs_confIDs)
    apply (metis Suc_n_not_le_n paperIDs_geq_subPH)+ .
  subgoal for x2 apply(cases x2,auto simp: u_defs isRev_def2) .
  subgoal for x3 apply(cases x3,auto simp: uu_defs isRev_def2) .
  by auto

lemma Î³_notÏ_eqButPID_outErr:
assumes sT: "reachNT s" and s1: "reach s1"
and UIDs: "userOfA a â UIDs" and step: "step s a = (outErr,s')" (* and Ï: "Â¬ Ï a" *)
and ss1: "eqExcPID s s1" and PID: "PID ââ paperIDs s CID"
shows "step s1 a = (outErr,s1)"
proof-
  have s: "reach s" by (metis reachNT_reach sT)
  have step: "step s a = (outErr,s)" using step by (metis step_outErr_eq)
  note Inv = reachNT_non_isPC_isChair[OF sT UIDs]
  note eqs = eqExcPID_imp[OF ss1]
  note eqs' = eqExcPID_imp1[OF ss1]
  have PID1: "PID ââ paperIDs s1 CID" using ss1 PID unfolding eqExcPID_def by auto

  note simps[simp] = c_defs u_defs uu_defs r_defs l_defs Paper_dest_conv eqExcPID_def
  note simps2[simp] = eqExcRLR_imp[of s _ _ _ s1, OF s]
      eqExcRLR_imp2[of s _ _ s1]
      eqExcRLR_set[of "(roles s cid uid)" "(roles s1 cid uid)" for cid uid]
      foo2 foo3
      eqExcRLR_imp_isRevRole_imp

  note * = step eqs eqs' s s1 UIDs (* Ï *) PID PID1 paperIDs_equals[OF s] Inv

  show ?thesis
  proof (cases a)
    case (Cact x1)
    with * show ?thesis
      by (cases x1; auto; metis less_irrefl_nat simps2(1))
  next
    case (Uact x2)
    with * show ?thesis
      by (cases x2; auto; metis isRev_pref_notConflict_isPC less_irrefl_nat simps2(1))
  next
    case (UUact x3)
    with * show ?thesis
      by (cases x3; auto; metis eqs isRev_isPC less_Suc_eq less_irrefl_nat pref_Conflict_isRev simps2(1))
  next
    case (Ract x4)
    with * show ?thesis
      by (cases x4; auto; metis isRev_isPC not_less pref_Conflict_isRev s1 simps2(1))
  next
    case (Lact x5)
    with * show ?thesis
      by (cases x5; auto)
  qed
qed

lemma exists_failedAct:
"â a. step s a = (outErr,s) â§ userOfA a = uid"
proof-
  obtain p where p: "pass s uid = Password p"
    by (cases "pass s uid")
  let ?a = "Cact (cConf undefined uid (Password (fresh {p} p)) undefined undefined)"
  show ?thesis apply(rule exI[of _ ?a]) using p fresh_notIn[of "{p}" p] by(auto simp: c_defs)
qed

lemma unwind_cont_Î2: "unwind_cont Î2 {Î2,Î3,Îe}"
proof(rule, simp)
  let ?Î = "Î»s vl s1 vl1. Î2 s vl s1 vl1 â¨ Î3 s vl s1 vl1 â¨ Îe s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Î2 s vl s1 vl1"
  then obtain CID uidc where uidc: "isChair s CID uidc â§ pref s uidc PID â  Conflict"
  and rs: "reach s" and ph: "phase s CID = revPH" (is "?ph = _") and ss1: "eqExcPID s s1"
  and PID: "PID ââ paperIDs s CID"
  and dis: "distinct (map fst vl1)"
  and l: "length vl = length vl1"
  and fst_isPC: "fst ` (set vl1) â {uid'. isPC s CID uid' â§ pref s uid' PID â  Conflict}"
  and fst_isRev: "fst ` (set vl1) â© {uid'. isRev s1 CID uid' PID} = {}"
  and snd_isPC: "snd ` (set vl1) â {{uid'. isPC s CID uid' â§ pref s uid' PID â  Conflict}}"
  using reachNT_reach unfolding Î2_def by auto
  hence uidc_notin: "uidc â UIDs" using less_not_refl3 reachNT_non_isPC_isChair rsT by fastforce
  note vl1_all = dis fst_isPC fst_isRev snd_isPC
  have PID1: "PID ââ paperIDs s1 CID" using PID ss1 unfolding eqExcPID_def by auto
  show "iaction ?Î s vl s1 vl1 â¨
        ((vl = [] â¶ vl1 = []) â§ reaction ?Î s vl s1 vl1)" (is "?iact â¨ (_ â§ ?react)")
  proof-
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      let ?ph' = "phase s' CID"
      assume step: "step s a = (ou, s')" and T: "Â¬ T ?trn" and c: "consume ?trn vl vl'"
      have PID': "PID ââ paperIDs s' CID" using PID rs by (metis paperIDs_mono step)
      have uidc': "isChair s' CID uidc â§ pref s' uidc PID â  Conflict"
      using uidc step rs ph PID isChair_persistent revPH_pref_persists[OF rs PID ] by auto
      show "match ?Î s s1 vl1 a ou s' vl' â¨ ignore ?Î s s1 vl1 a ou s' vl'" (is "?match â¨ ?ignore")
      proof(cases "Ï ?trn")
        case False note Ï = False
        have vl': "vl' = vl" using c Ï unfolding consume_def by (cases vl) auto
        obtain ou1 and s1' where step1: "step s1 a = (ou1,s1')" by (metis prod.exhaust)
        let ?trn1 = "Trans s1 a ou1 s1'"
        show ?thesis
        proof(cases "ou = outErr")
          case True note ou = True
          have s': "s' = s" by (metis ou step step_outErr_eq)
          show ?thesis
          proof (cases "userOfA a â UIDs")
            case True note uidUIDs = True
            hence ou1: "ou1 = outErr" using Î³_notÏ_eqButPID_outErr
            by (metis PID Pair_inject ou rs1 rsT ss1 step step1)
            hence s1': "s1' = s1" by (metis step1 step_outErr_eq)
            have Ï1: "Â¬ Ï ?trn1" unfolding Ï_def2 ou1 by auto
            have ?match proof
              show "validTrans ?trn1" using step1 by simp
            next
              show "consume ?trn1 vl1 vl1" unfolding consume_def using Ï1 by auto
            next
              show "Î³ ?trn = Î³ ?trn1" by simp
            next
              assume "Î³ ?trn" thus "g ?trn = g ?trn1" unfolding ou ou1 by simp
            next
              show "?Î s' vl' s1' vl1" unfolding s' s1' vl' by (metis â¹Î2 s vl s1 vl1âº)
            qed
            thus ?thesis by simp
          next
            case False note uidUIDs = False
            obtain a1 where ua1: "userOfA a1 = userOfA a" and step1: "step s1 a1 = (outErr,s1)"
            by (metis exists_failedAct ou)
            let ?trn1 = "Trans s1 a1 outErr s1"
            have ?match proof
              show "validTrans ?trn1" using step1 by simp
            next
              show "consume ?trn1 vl1 vl1" unfolding consume_def Ï_def2 ou by auto
            next
              show "Î³ ?trn = Î³ ?trn1" by (simp add: ua1)
            next
              assume "Î³ ?trn" thus "g ?trn = g ?trn1" using uidUIDs unfolding ou by simp
            next
              show "?Î s' vl' s1 vl1" unfolding s' vl' by (metis â¹Î2 s vl s1 vl1âº)
            qed
            thus ?thesis by simp
          qed
        next
          case False note ou = False
          show ?thesis
          proof(cases "Ï a")
            case False note Ï = False
            have s's1': "eqExcPID s' s1'" using eqExcPID_step rs rs1 ss1 step step1 PID Ï Ï ou by blast
            have Ï1: "Â¬ Ï ?trn1" using Ï using non_eqExcPID_step_Ï_imp rs rs1 ss1 PID step step1 ou by auto
            have out: "userOfA a â UIDs â¶ ou1 = ou"
            using eqExcPID_step_out[OF ss1 step step1 rsT rs1 PID _ Ï Ï1 Ï] ph by auto
            have ?match proof
              show "validTrans ?trn1" using step1 by simp
            next
              show "consume ?trn1 vl1 vl1" unfolding consume_def using Ï1 by auto
            next
              show "Î³ ?trn = Î³ ?trn1" unfolding ss1 by simp
            next
              assume "Î³ ?trn" thus "g ?trn = g ?trn1" using out by simp
            next
              show "?Î s' vl' s1' vl1"
              proof(cases "phase s' CID = revPH")
                case True
                hence "Î2 s' vl' s1' vl1" using uidc' PID' s's1' vl1_all l unfolding Î2_def vl'
                apply(intro exI[of _ CID] exI[of _ uidc]) apply simp apply(intro conjI)
                using isPC_persistent[OF _ step] revPH_pref_persists[OF rs PID _ step] ph
                not_Ï_isRev_isPC_persists[OF rs1 PID1 Ï1 step1]
                revPH_pref_persists[OF rs PID _ step] not_Ï_isRev_isPC_persists[OF rs PID Ï step] ph
                by auto
                thus "?Î s' vl' s1' vl1" by simp
              next
                case False
                hence ph': "phase s' CID > revPH" using rs step ph by (metis antisym_conv2 phase_increases)
                show ?thesis
                proof(cases "vl = []")
                  case True hence "vl1 = []" using l by simp
                  hence "Î3 s' vl' s1' vl1" using uidc' PID' s's1' ph' unfolding Î3_def vl' by auto
                  thus ?thesis by simp
                next
                  case False
                  hence "Îe s' vl' s1' vl1" using PID' ph' unfolding Îe_def vl' by auto
                  thus ?thesis by simp
                qed
              qed
            qed
            thus ?thesis by simp
          next
            case True
            thus ?thesis unfolding Ï_def2 proof(elim exE disjE)
              fix cid uid p n rc assume a: "a = Uact (uReview cid uid p PID n rc)"
              hence ou: "ou = outOK" using step ou unfolding a by (auto simp: u_defs)
              obtain s1' uid1 p where
              uid1: "isRevNth s1 cid uid1 PID n"
              and step1: "step s1 (Uact (uReview cid uid1 p PID n rc)) = (outOK,s1')" (is "step _ ?a1 = _")
              and s's1': "eqExcPID s' s1'" using eqExcPID_step_Ï1 rs rs1 a ss1 step ou by metis
              let ?trn1 = "Trans s1 ?a1 outOK s1'"
              have Ï1: "Â¬ Ï ?trn1" by simp
              have "isPC s cid uid â§ pref s uid PID â  Conflict"
              using step unfolding a ou apply(auto simp: u_defs)
              by (metis isRev_pref_notConflict_isPC rs)+
              hence uidUIDs: "Â¬ uid â UIDs" using ph reachNT_non_isPC_isChair[OF rsT] apply auto
              by (metis PID PID1 isRevNth_paperIDs less_irrefl_nat paperIDs_equals rs1 uid1)
              have "isPC s1 cid uid1 â§ pref s1 uid1 PID â  Conflict" using step1  apply(auto simp: u_defs)
              by (metis isRev_pref_notConflict_isPC rs1)+
              hence "isPC s cid uid1 â§ pref s uid1 PID â  Conflict" using ss1 unfolding eqExcPID_def
              using eqExcRLR_imp2 by fastforce
              hence uid1UIDs: "Â¬ uid1 â UIDs" using ph reachNT_non_isPC_isChair[OF rsT] apply auto
              by (metis (no_types, opaque_lifting) eqExcPID_def isRevNth_geq_revPH isRevNth_paperIDs not_le rs1 ss1 uid1)
              have ph': "phase s' CID = revPH" using ph step unfolding a by (auto simp: u_defs)
              have ?match proof
                show "validTrans ?trn1" using step1 by simp
              next
                show "consume ?trn1 vl1 vl1" unfolding consume_def using Ï1 by auto
              next
                show "Î³ ?trn = Î³ ?trn1" using uidUIDs uid1UIDs unfolding a by simp
              next
                assume "Î³ ?trn" thus "g ?trn = g ?trn1" using uidUIDs unfolding a by simp
              next
                have "Î2 s' vl' s1' vl1" using ph' PID' s's1' unfolding Î2_def vl'
                apply(intro exI[of _ CID] exI[of _ uidc]) using l vl1_all
                using isPC_persistent[OF _ step] revPH_pref_persists[OF rs PID _ step] ph
                not_Ï_isRev_isPC_persists[OF rs1 PID1 Ï1 step1]
                revPH_pref_persists[OF rs PID _ step] not_Ï_isRev_isPC_persists[OF rs PID Ï step] ph uidc'
                by auto
                thus "?Î s' vl' s1' vl1" by simp
              qed
              thus ?thesis by simp
            next
              fix cid uid p n rc assume a: "a = UUact (uuReview cid uid p PID n rc)"
              hence ou: "ou = outOK" using step ou unfolding a by (auto simp: uu_defs)
              obtain s1' uid1 p where
              uid1: "isRevNth s1 cid uid1 PID n"
              and step1: "step s1 (UUact (uuReview cid uid1 p PID n rc)) = (outOK,s1')" (is "step _ ?a1 = _")
              and s's1': "eqExcPID s' s1'" using eqExcPID_step_Ï2 rs rs1 a ss1 step ou by metis
              let ?trn1 = "Trans s1 ?a1 outOK s1'"
              have Ï1: "Â¬ Ï ?trn1" by simp
              have "isPC s cid uid â§ pref s uid PID â  Conflict"
              using step unfolding a ou apply(auto simp: uu_defs)
              by (metis isRev_pref_notConflict_isPC rs)+
              hence uidUIDs: "Â¬ uid â UIDs" using ph reachNT_non_isPC_isChair[OF rsT] apply auto
              by (metis (no_types, opaque_lifting) eqExcPID_def isRevNth_geq_revPH isRevNth_paperIDs not_le rs1 ss1 uid1)
              have "isPC s1 cid uid1 â§ pref s1 uid1 PID â  Conflict" using step1  apply(auto simp: uu_defs)
              by (metis isRev_pref_notConflict_isPC rs1)+
              hence "isPC s cid uid1 â§ pref s uid1 PID â  Conflict" using ss1 unfolding eqExcPID_def
              using eqExcRLR_imp2 by fastforce
              hence uid1UIDs: "Â¬ uid1 â UIDs" using ph reachNT_non_isPC_isChair[OF rsT] apply auto
              by (metis (no_types, opaque_lifting) eqExcPID_def isRevNth_geq_revPH isRevNth_paperIDs not_le rs1 ss1 uid1)
              have ph': "phase s' CID = revPH" using ph step unfolding a by (auto simp: uu_defs)
              have ?match proof
                show "validTrans ?trn1" using step1 by simp
              next
                show "consume ?trn1 vl1 vl1" unfolding consume_def using Ï1 by auto
              next
                show "Î³ ?trn = Î³ ?trn1" using uidUIDs uid1UIDs unfolding a by simp
              next
                assume "Î³ ?trn" thus "g ?trn = g ?trn1" using uidUIDs unfolding a by simp
              next
                have "Î2 s' vl' s1' vl1" using ph' PID' s's1' unfolding Î2_def vl'
                apply(intro exI[of _ CID] exI[of _ uidc]) using l vl1_all
                using isPC_persistent[OF _ step] revPH_pref_persists[OF rs PID _ step] ph
                not_Ï_isRev_isPC_persists[OF rs1 PID1 Ï1 step1]
                revPH_pref_persists[OF rs PID _ step] not_Ï_isRev_isPC_persists[OF rs PID Ï step] ph uidc'
                by auto
                thus "?Î s' vl' s1' vl1" by simp
              qed
              thus ?thesis by simp
            qed
          qed
        qed
      next
        case True note Ï = True
        then obtain cid uid p uid' where  a: "a = Cact (cReview cid uid p PID uid')"
        (* have ua: "userOfA a â UIDs" by (metis Ï T_Ï_Î³ Î³.simps rsT step) *)
        and ou: "ou = outOK" unfolding Ï_def2 by auto
        have cid: "cid = CID" using step unfolding a ou apply(auto simp: c_defs)
        by (metis PID paperIDs_equals rs)
        obtain v vll' where "vl = v # vll'" using Ï c unfolding consume_def by (cases vl) auto
        hence vl: "vl = v # vl'" by (metis Ï c consume_def list.sel(2-3))
        obtain v1 vl1' where vl1: "vl1 = v1 # vl1'" using l vl by (cases vl1) auto
        obtain uid1' where v1: "v1 = (uid1', {uid1'. isPC s CID uid1' â§ pref s uid1' PID â  Conflict})"
        using snd_isPC unfolding vl1 by(cases v1) auto
        hence uid1': "isPC s CID uid1' â§ pref s uid1' PID â  Conflict" and uid1'1: "Â¬ isRev s1 CID uid1' PID"
        using fst_isPC fst_isRev unfolding vl1 by auto
        have uid: "isChair s CID uid â§ pref s uid PID â  Conflict"
        using step unfolding a ou cid by (auto simp: c_defs)
        have uid1: "isChair s1 CID uid â§ pref s1 uid PID â  Conflict"
        using ss1 uid unfolding eqExcPID_def using eqExcRLR_imp2 by metis
        have uuid1': "isPC s1 CID uid1' â§ pref s1 uid1' PID â  Conflict"
        using uid1' ss1 unfolding eqExcPID_def apply auto by (metis eqExcRLR_imp2)
        obtain a1 where a1: "a1 = Cact (cReview CID uid p PID uid1')" by blast
        obtain s1' ou1 where step1: "step s1 a1 = (ou1,s1')" by (metis prod.exhaust)
        have ph1: "phase s1 CID = revPH" using ss1 ph unfolding eqExcPID_def by auto
        let ?trn1 = "Trans s1 a1 ou1 s1'"
        have s's1': "eqExcPID s' s1'" and ou1: "ou1 = outOK"
        using eqExcPID_step_Ï_eqExcPID_out[OF rs rs1 a[unfolded cid]
                                              a1 ss1 step[unfolded ou] uid1' uid1'1 step1] by auto
        hence many_s1': "PID ââ paperIDs s1' CID" "isChair s1' CID uid â§ pref s1' uid PID â  Conflict"
        "phase s1' CID = revPH" "pass s1' uid = pass s1 uid"
        "isPC s1' CID uid1' â§ pref s1' uid1' PID â  Conflict"
          subgoal by (metis PID1 paperIDs_mono step1)
          subgoal by (metis (no_types, lifting) PID1 Suc_leI eqExcPID_def isChair_persistent lessI ph revPH_pref_persists rs1 ss1 step1 uid1)
          subgoal using step1 ph1 unfolding a1 by (fastforce simp: c_defs)
          subgoal using step1 ph1 unfolding a1 by (fastforce simp: c_defs)
          subgoal by (metis (no_types, lifting) PID1 Suc_leI eqExcPID_def isPC_persistent lessI ph revPH_pref_persists rs1 ss1 step1 uuid1')
          done
        hence more_s1': "uid ââ userIDs s1'" "CID ââ confIDs s1'"
        by (metis paperIDs_confIDs reach_PairI roles_userIDs rs1 step1 many_s1'(1))+
        have Ï1: "Ï ?trn1" unfolding a1 ou1 Ï_def2 by auto
        have f1: "f ?trn1 = v1" unfolding a1 v1 apply simp
        using ss1 unfolding eqExcPID_def using eqExcRLR_imp2
        by (metis eqExcRLR_set isRevRoleFor.simps(3))
        have rs1': "reach s1'" using rs1 step1 by (auto intro: reach_PairI)
        have ph': "phase s' CID = revPH" using step ph unfolding a by(auto simp: c_defs)
        have ?match proof
          show "validTrans ?trn1" using step1 by simp
          next
            show "consume ?trn1 vl1 vl1'" unfolding consume_def vl1 using Ï1 f1 by auto
          next
            show "Î³ ?trn = Î³ ?trn1" unfolding a a1 by simp
          next
            assume "Î³ ?trn" thus "g ?trn = g ?trn1" by (metis Ï T_Ï_Î³ Î³.simps rsT step)
          next
            have 0: "{uid'. isPC s' CID uid' â§ pref s' uid' PID â  Conflict} =
                     {uid'. isPC s CID uid' â§ pref s uid' PID â  Conflict}"
            using step rs ph unfolding a ou by (auto simp: c_defs)
            have 1: "{uid'. isRev s1' CID uid' PID} â {uid'. isRev s1 CID uid' PID} âª {uid1'}"
            using step1 unfolding a1 ou1 by (auto simp: c_defs isRev_def2)
            have 2: "fst ` set vl1' â fst ` set vl1 - {uid1'}" using dis
            unfolding vl1 apply simp unfolding image_set unfolding v1 by simp
            have 3: "fst ` set vl1' â© {uid'. isRev s1' CID uid' PID} = {}"
            using 1 2 vl1_all(3) by blast
            have "Î2 s' vl' s1' vl1'" unfolding Î2_def
            apply(intro exI[of _ CID] exI[of _ uidc]) using l vl1_all unfolding vl1 vl apply simp
            using PID' ph' uidc' s's1' apply simp
            unfolding 0 using 3 by simp
            thus "?Î s' vl' s1' vl1'" by simp
        qed
        thus ?thesis by simp
      qed
    qed
    thus ?thesis using l by (metis length_0_conv)
  qed
qed

lemma unwind_cont_Î3: "unwind_cont Î3 {Î3,Îe}"
proof(rule, simp)
  let ?Î = "Î»s vl s1 vl1. Î3 s vl s1 vl1 â¨ Îe s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Î3 s vl s1 vl1"
  then obtain CID where rs: "reach s" and ph: "phase s CID > revPH" (is "?ph > _")
  and PID: "PID ââ paperIDs s CID" and ss1: "eqExcPID s s1"
  and vl1: "vl1 = []"
  using reachNT_reach unfolding Î3_def by auto
  have PID1: "PID ââ paperIDs s1 CID"
  by (metis PID eqExcPID_sym isAut_paperIDs notInPaperIDs_eqExcPID_roles_eq paperID_ex_userID rs rs1 ss1)
  show "iaction ?Î s vl s1 vl1 â¨
        ((vl = [] â¶ vl1 = []) â§ reaction ?Î s vl s1 vl1)" (is "?iact â¨ (_ â§ ?react)")
  proof-
    have "?react"
    proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      let ?ph' = "phase s' CID"
      assume step: "step s a = (ou, s')" and T: "Â¬ T ?trn" and c: "consume ?trn vl vl'"
      have PID': "PID ââ paperIDs s' CID" using PID rs by (metis paperIDs_mono step)
      have ph': "phase s' CID > revPH" using ph rs
      by (meson less_le_trans local.step phase_increases)
      have Ï: "Â¬ Ï ?trn" using step ph unfolding Ï_def2 apply(auto simp: c_defs)
      using PID paperIDs_equals rs by force
      have vl': "vl' = vl" using c Ï unfolding consume_def by (cases vl) auto
      show "match ?Î s s1 vl1 a ou s' vl' â¨ ignore ?Î s s1 vl1 a ou s' vl'" (is "?match â¨ ?ignore")
      proof(cases "Ï a")
        case True
        thus ?thesis unfolding Ï_def2 proof(elim exE disjE)
          fix cid uid p n rc assume a: "a = Uact (uReview cid uid p PID n rc)"
          show ?thesis
          proof(cases "ou = outErr")
             case True note ou = True
             hence s's: "s' = s" by (metis step step_outErr_eq)
             show ?thesis proof(cases "uid â UIDs")
               case True note uidUIDs = True
               obtain ou1 and s1' where step1: "step s1 a = (ou1,s1')" by (metis prod.exhaust)
               let ?trn1 = "Trans s1 a ou1 s1'"
               have "isPC s CID uid â¶ pref s uid PID = Conflict"
               using reachNT_non_isPC_isChair[OF rsT uidUIDs] ph PID by force
               hence 1: "isPC s1 CID uid â¶ pref s1 uid PID = Conflict" using ss1 unfolding eqExcPID_def
               using eqExcRLR_imp2 by fastforce
               have ou1: "ou1 = outErr" using step1 uidUIDs unfolding a apply(auto simp: u_defs)
               apply(cases "cid = CID", auto)
               apply (metis 1 isRev_isPC isRev_pref_notConflict rs1)
               by (metis rs1 PID1 paperIDs_equals)
               have s1's1: "s1' = s1" by (metis ou ou1 step step1 step_outErr_eq)
               have Ï1: "Â¬ Ï ?trn1" using Ï unfolding eqExcPID_step_Ï[OF rs rs1 ss1 PID ph step step1] .
               have ?match proof
                 show "validTrans ?trn1" using step1 by simp
               next
                 show "consume ?trn1 vl1 vl1" unfolding consume_def using Ï1 by auto
               next
                 show "Î³ ?trn = Î³ ?trn1" unfolding ss1 by simp
               next
                 assume "Î³ ?trn" thus "g ?trn = g ?trn1" unfolding ou ou1 by simp
               next
                 have "Î3 s' vl' s1' vl1" using ph' PID' ss1 unfolding Î3_def s's s1's1 vl1 by auto
                 thus "?Î s' vl' s1' vl1" by simp
               qed
               thus ?thesis by simp
             next
               case False note uidUIDs = False
               have ?ignore proof
                 show "Â¬ Î³ ?trn" using uidUIDs unfolding a by auto
               next
                 have "Î3 s' vl' s1 vl1" using ph' PID' ss1 unfolding Î3_def s's vl1 by auto
                 thus "?Î s' vl' s1 vl1" by simp
               qed
               thus ?thesis by simp
             qed
          next
             case False hence ou: "ou = outOK" using step unfolding a by (auto simp: u_defs)
             obtain s1' uid1 p where
             uid1: "isRevNth s1 cid uid1 PID n"
             and step1: "step s1 (Uact (uReview cid uid1 p PID n rc)) = (outOK,s1')" (is "step _ ?a1 = _")
             and s's1': "eqExcPID s' s1'" using eqExcPID_step_Ï1 rs rs1 a ss1 step ou by metis
             let ?trn1 = "Trans s1 ?a1 outOK s1'"
             have Ï1: "Â¬ Ï ?trn1" by simp
             have "isPC s cid uid â§ pref s uid PID â  Conflict" using step unfolding a ou apply(auto simp: u_defs)
             by (metis isRev_pref_notConflict_isPC rs)+
             hence uidUIDs: "Â¬ uid â UIDs" using ph reachNT_non_isPC_isChair[OF rsT] apply auto
             by (metis (no_types, opaque_lifting) eqExcPID_def isRevNth_geq_revPH isRevNth_paperIDs not_le rs1 ss1 uid1)
             have "isPC s1 cid uid1 â§ pref s1 uid1 PID â  Conflict" using step1  apply(auto simp: u_defs)
             by (metis isRev_pref_notConflict_isPC rs1)+
             hence "isPC s cid uid1 â§ pref s uid1 PID â  Conflict" using ss1 unfolding eqExcPID_def
             using eqExcRLR_imp2 by fastforce
             hence uid1UIDs: "Â¬ uid1 â UIDs" using ph reachNT_non_isPC_isChair[OF rsT] apply auto
             by (metis (no_types, opaque_lifting) eqExcPID_def isRevNth_geq_revPH isRevNth_paperIDs not_le rs1 ss1 uid1)
             have ?match proof
               show "validTrans ?trn1" using step1 by simp
             next
               show "consume ?trn1 vl1 vl1" unfolding consume_def using Ï1 by auto
             next
               show "Î³ ?trn = Î³ ?trn1" using uidUIDs uid1UIDs unfolding a by simp
             next
               assume "Î³ ?trn" thus "g ?trn = g ?trn1" using uidUIDs unfolding a by simp
             next
               have "Î3 s' vl' s1' vl1" using ph' PID' s's1' unfolding Î3_def vl1 by auto
               thus "?Î s' vl' s1' vl1" by simp
             qed
             thus ?thesis by simp
          qed
        next
          fix cid uid p n rc assume a: "a = UUact (uuReview cid uid p PID n rc)"
           show ?thesis
          proof(cases "ou = outErr")
             case True note ou = True
             hence s's: "s' = s" by (metis step step_outErr_eq)
             show ?thesis proof(cases "uid â UIDs")
               case True note uidUIDs = True
               obtain ou1 and s1' where step1: "step s1 a = (ou1,s1')" by (metis prod.exhaust)
               let ?trn1 = "Trans s1 a ou1 s1'"
               have "isPC s CID uid â¶ pref s uid PID = Conflict"
               using reachNT_non_isPC_isChair[OF rsT uidUIDs] ph PID by force
               hence 1: "isPC s1 CID uid â¶ pref s1 uid PID = Conflict" using ss1 unfolding eqExcPID_def
               using eqExcRLR_imp2 by fastforce
               have ou1: "ou1 = outErr" using step1 uidUIDs unfolding a apply(auto simp: uu_defs)
               apply(cases "cid = CID", auto)
               apply (metis 1 isRev_isPC isRev_pref_notConflict rs1)
               by (metis rs1 PID1 paperIDs_equals)
               have s1's1: "s1' = s1" by (metis ou ou1 step step1 step_outErr_eq)
               have Ï1: "Â¬ Ï ?trn1" using Ï unfolding eqExcPID_step_Ï[OF rs rs1 ss1 PID ph step step1] .
               have ?match proof
                 show "validTrans ?trn1" using step1 by simp
               next
                 show "consume ?trn1 vl1 vl1" unfolding consume_def using Ï1 by auto
               next
                 show "Î³ ?trn = Î³ ?trn1" unfolding ss1 by simp
               next
                 assume "Î³ ?trn" thus "g ?trn = g ?trn1" unfolding ou ou1 by simp
               next
                 have "Î3 s' vl' s1' vl1" using ph' PID' ss1 unfolding Î3_def s's s1's1 vl1 by auto
                 thus "?Î s' vl' s1' vl1" by simp
               qed
               thus ?thesis by simp
             next
               case False note uidUIDs = False
               have ?ignore proof
                 show "Â¬ Î³ ?trn" using uidUIDs unfolding a by auto
               next
                 have "Î3 s' vl' s1 vl1" using ph' PID' ss1 unfolding Î3_def s's vl1 by auto
                 thus "?Î s' vl' s1 vl1" by simp
               qed
               thus ?thesis by simp
             qed
          next
             case False hence ou: "ou = outOK" using step unfolding a by (auto simp: u_defs)
             obtain s1' uid1 p where
             uid1: "isRevNth s1 cid uid1 PID n"
             and step1: "step s1 (UUact (uuReview cid uid1 p PID n rc)) = (outOK,s1')" (is "step _ ?a1 = _")
             and s's1': "eqExcPID s' s1'" using eqExcPID_step_Ï2 rs rs1 a ss1 step ou by metis
             let ?trn1 = "Trans s1 ?a1 outOK s1'"
             have Ï1: "Â¬ Ï ?trn1" by simp
             have "isPC s cid uid â§ pref s uid PID â  Conflict" using step unfolding a ou apply(auto simp: uu_defs)
             by (metis isRev_pref_notConflict_isPC rs)+
             hence uidUIDs: "Â¬ uid â UIDs" using ph reachNT_non_isPC_isChair[OF rsT] apply auto
             by (metis (no_types, opaque_lifting) eqExcPID_def isRevNth_geq_revPH isRevNth_paperIDs not_le rs1 ss1 uid1)
             have "isPC s1 cid uid1 â§ pref s1 uid1 PID â  Conflict" using step1  apply(auto simp: uu_defs)
             by (metis isRev_pref_notConflict_isPC rs1)+
             hence "isPC s cid uid1 â§ pref s uid1 PID â  Conflict" using ss1 unfolding eqExcPID_def
             using eqExcRLR_imp2 by fastforce
             hence uid1UIDs: "Â¬ uid1 â UIDs" using ph reachNT_non_isPC_isChair[OF rsT] apply auto
             by (metis (no_types, opaque_lifting) eqExcPID_def isRevNth_geq_revPH isRevNth_paperIDs not_le rs1 ss1 uid1)
             have ?match proof
               show "validTrans ?trn1" using step1 by simp
             next
               show "consume ?trn1 vl1 vl1" unfolding consume_def using Ï1 by auto
             next
               show "Î³ ?trn = Î³ ?trn1" using uidUIDs uid1UIDs unfolding a by simp
             next
               assume "Î³ ?trn" thus "g ?trn = g ?trn1" using uidUIDs unfolding a by simp
             next
               have "Î3 s' vl' s1' vl1" using ph' PID' s's1' unfolding Î3_def vl1 by auto
               thus "?Î s' vl' s1' vl1" by simp
             qed
             thus ?thesis by simp
          qed
        qed
      next
        case False note Ï = False
        obtain ou1 and s1' where step1: "step s1 a = (ou1,s1')" by (metis prod.exhaust)
        let ?trn1 = "Trans s1 a ou1 s1'"
        have Ï1: "Â¬ Ï ?trn1" using Ï unfolding eqExcPID_step_Ï[OF rs rs1 ss1 PID ph step step1] .
        have out: "userOfA a â UIDs â¶ ou1 = ou"
        using eqExcPID_step_out[OF ss1 step step1 rsT rs1 PID _ Ï Ï1 Ï] ph by auto
        have s's1': "eqExcPID s' s1'" using eqExcPID_step rs rs1 ss1 step step1 PID ph Ï Ï by blast
        have ?match proof
          show "validTrans ?trn1" using step1 by simp
        next
          show "consume ?trn1 vl1 vl1" unfolding consume_def using Ï1 by auto
        next
          show "Î³ ?trn = Î³ ?trn1" unfolding ss1 by simp
        next
          assume "Î³ ?trn" thus "g ?trn = g ?trn1" using out by simp
        next
          have "Î3 s' vl' s1' vl1" using ph' PID' s's1' unfolding Î3_def vl1 by auto
          thus "?Î s' vl' s1' vl1" by simp
        qed
        thus ?thesis by simp
      qed
    qed
    thus ?thesis using vl1 by simp
  qed
qed


(* Exit arguments: *)
definition K1exit where
"K1exit cid s â¡ PID ââ paperIDs s cid â§ phase s cid â¥ revPH â§
                Â¬ (â uid. isChair s cid uid â§ pref s uid PID â  Conflict)"

lemma invarNT_K1exit: "invarNT (K1exit cid)"
unfolding invarNT_def apply (safe dest!: reachNT_reach)
  subgoal for _ a apply(cases a)
    subgoal for x1 apply(cases x1) apply (fastforce simp add: c_defs K1exit_def geq_noPH_confIDs)+ .
    subgoal for x2 apply(cases x2) apply (auto simp add: u_defs K1exit_def paperIDs_equals)
      apply (metis less_eq_Suc_le less_not_refl paperIDs_equals) .
    subgoal for x3 apply(cases x3) apply (auto simp add: uu_defs K1exit_def) .
    by auto
  done

lemma noVal_K1exit: "noVal (K1exit cid) v"
  apply(rule noÏ_noVal)
  unfolding noÏ_def apply safe
  subgoal for _ a apply(cases a)
    subgoal for x1 apply(cases x1)
      apply (auto simp add: c_defs K1exit_def)
      by (metis paperIDs_equals reachNT_reach)
    by auto
  done

definition K2exit where
"K2exit cid s v â¡
 PID ââ paperIDs s cid â§ phase s cid â¥ revPH â§
 snd v â  {uid'. isPC s cid uid' â§ pref s uid' PID â  Conflict}"

lemma revPH_isPC_constant:
assumes s: "reach s"
and "step s a = (ou,s')"
and "pid ââ paperIDs s cid" and "phase s cid â¥ revPH"
shows "isPC s' cid uid' = isPC s cid uid'"
using assms apply(cases a)
  subgoal for x1 apply(cases x1) apply (auto simp add: c_defs)
    apply (metis paperIDs_confIDs) .
  subgoal for x2 apply(cases x2) apply (auto simp add: u_defs) .
  subgoal for x3 apply(cases x3) apply (auto simp add: uu_defs) .
  by auto

lemma revPH_pref_constant:
assumes s: "reach s"
and "step s a = (ou,s')"
and "pid ââ paperIDs s cid" and "phase s cid â¥ revPH"
shows "pref s' uid pid = pref s uid pid"
using assms apply(cases a)
  subgoal for x1 apply(cases x1) apply (auto simp add: c_defs)
    apply (metis paperIDs_getAllPaperIDs)
    apply (metis Suc_n_not_le_n le_SucI paperIDs_equals)
    apply (metis Suc_n_not_le_n le_SucI paperIDs_equals) .
  subgoal for x2 apply(cases x2) apply (auto simp add: u_defs)
    apply (metis Suc_n_not_le_n paperIDs_equals) .
  subgoal for x3 apply(cases x3) apply (auto simp add: uu_defs) .
  by auto

lemma invarNT_K2exit: "invarNT (Î» s. K2exit cid s v)"
unfolding invarNT_def apply (safe dest!: reachNT_reach)
unfolding K2exit_def
by (smt Collect_cong le_trans paperIDs_mono phase_increases revPH_isPC_constant revPH_pref_constant)


(* An even more interesting invariant than the one in Review_Confidentiality/RAut:
it requires the binary version noVal2  *)
lemma noVal_K2exit: "noVal2 (K2exit cid) v"
unfolding noVal2_def apply safe
  subgoal for _ a apply(cases a)
    subgoal for x1 apply(cases x1)
             apply (auto simp add: c_defs K2exit_def)
       apply (metis paperIDs_equals reachNT_reach)+ .
    by auto
  done

definition K3exit where
"K3exit cid s â¡ PID ââ paperIDs s cid â§ phase s cid > revPH"

lemma invarNT_K3exit: "invarNT (K3exit cid)"
unfolding invarNT_def apply (safe dest!: reachNT_reach)
  subgoal for _ a apply(cases a)
    subgoal for x1 apply(cases x1) apply (auto simp add: c_defs K3exit_def) .
    subgoal for x2 apply(cases x2) apply (auto simp add: u_defs K3exit_def) .
    subgoal for x3 apply(cases x3) apply (auto simp add: uu_defs K3exit_def) .
    by auto
  done

lemma noVal_K3exit: "noVal (K3exit cid) v"
apply(rule noÏ_noVal)
unfolding noÏ_def apply safe
  subgoal for _ a apply(cases a)
    subgoal for x1 apply(cases x1)
             apply (auto simp add: c_defs K3exit_def)
      using reachNT_reach paperIDs_equals by fastforce
    by auto
  done

lemma unwind_exit_Îe: "unwind_exit Îe"
proof
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and Îe: "Îe s vl s1 vl1"
  hence vl: "vl â  []" using reachNT_reach unfolding Îe_def by auto
  then obtain CID where "K1exit CID s â¨ K2exit CID s (hd vl) â¨ K3exit CID s"
  using Îe unfolding K1exit_def K2exit_def K3exit_def Îe_def by auto
  thus "vl â  [] â§ exit s (hd vl)" apply(simp add: vl)
  by (metis exitI2 exitI2_noVal2 invarNT_K1exit invarNT_K2exit invarNT_K3exit
            noVal_K1exit noVal_K2exit noVal_K3exit rsT)
qed

theorem secure: secure
apply(rule unwind_decomp3_secure[of Î1 Î2 Îe Î3])
using
istate_Î1
unwind_cont_Î1 unwind_cont_Î2 unwind_cont_Î3
unwind_exit_Îe
by auto

end

Theory Reviewer_Assignment_NCPC_Aut

theory Reviewer_Assignment_NCPC_Aut
imports "../Observation_Setup" Reviewer_Assignment_Value_Setup "Bounded_Deducibility_Security.Compositional_Reasoning"
begin

subsection â¹Confidentiality protection from users who are not PC members
or authors of the paperâº

text â¹We verify the following property:

\ \\
A group of users UIDs learn
nothing about the reviewers assigned to a paper PID
except for the fact that they are PC members having no conflict with that paper
unless/until one of the following occurs:
\begin{itemize}
\item the user becomes a PC member in the paper's conference having no conflict
     with that paper and the conference moves to the reviewing phase,
or
\item the user becomes an author of the paper
   and the conference moves to the notification phase.
\end{itemize}
âº

fun T :: "(state,act,out) trans â bool" where
"T (Trans _ _ ou s') =
 (â uid â UIDs.
    (â cid. PID ââ paperIDs s' cid â§ isPC s' cid uid â§ pref s' uid PID â  Conflict â§ phase s' cid â¥ revPH)
    â¨
    (â cid. PID ââ paperIDs s' cid â§ isAut s' cid uid PID â§ phase s' cid â¥ notifPH)
 )"


declare T.simps [simp del]

(*
The bound says that a sequence of values vl,
i.e., a sequence of pairs [(uid_1,Uids_1),...,(uid_n,Uids_n)]
representing the users uid_i appointed as reviewers and the set
of PC members Uids_i not having conflict with paper ID at the time,
cannot be distinguished from a sequence of values
vl' = [(uid'_1,Uids'_1),...,(uid'_m,Uids'_m)] provided that
-- uid'_1,...,uid'_m are all distinct
-- Uids'_1 are all equal, and they are all equal to U
-- uid'_1 is in U

where U = Uids_1. Note actually that, because in the Reviewing phase
conflicts can no longer be changed, we actually have
U = Uids_1 = ... = Uids_n, which explains the above bound.

Thus, the second component of values (which turns out be constant)
is only collected in order to be able to express the following piece of information:
"the appointed reviewers are PC members having no conflict with paper".
*)

definition B :: "value list â value list â bool" where
"B vl vl1 â¡
 vl â  [] â§
 distinct (map fst vl1) â§ fst ` (set vl1) â snd (hd vl) â§ snd ` (set vl1) = {snd (hd vl)}"

interpretation BD_Security_IO where
istate = istate and step = step and
Ï = Ï and f = f and Î³ = Î³ and g = g and T = T and B = B
done

lemma reachNT_non_isPC_isChair:
assumes "reachNT s" and "uid â UIDs"
shows
"(PID ââ paperIDs s cid â§ isPC s cid uid â¶ pref s uid PID = Conflict â¨ phase s cid < revPH)
 â§
 (PID ââ paperIDs s cid â§ isChair s cid uid â¶ pref s uid PID = Conflict â¨ phase s cid < revPH)
 â§
 (PID ââ paperIDs s cid â§ isAut s cid uid PID â¶
    phase s cid < notifPH)"
  using assms
  apply induct
  subgoal by (auto simp: istate_def)
  subgoal apply(intro conjI)
    subgoal by (metis (no_types, lifting) T.simps not_le_imp_less trans.collapse)
    subgoal by (metis (mono_tags, lifting) reachNT_reach T.simps isChair_isPC not_le_imp_less reach.Step trans.collapse)
    subgoal by (metis T.simps not_le_imp_less trans.collapse) .
  done

lemma T_Ï_Î³:
assumes 1: "reachNT s" and 2: "step s a = (ou,s')" "Ï (Trans s a ou s')"
shows "Â¬ Î³ (Trans s a ou s')"
using reachNT_non_isPC_isChair[OF 1] 2 unfolding T.simps Ï_def2
by (fastforce simp: c_defs isRev_imp_isRevNth_getReviewIndex)

lemma T_Ï_Î³_stronger:
assumes s: "reach s" and 0: "PID ââ paperIDs s cid"
and 2: "step s a = (ou,s')" "Ï (Trans s a ou s')"
and 1:  "â uid â UIDs. isChair s cid uid â¶ pref s uid PID = Conflict â¨ phase s cid < revPH"
shows "Â¬ Î³ (Trans s a ou s')"
proof-
  have "Â¬ (â uid â UIDs. â cid. PID ââ paperIDs s cid â§
  isChair s cid uid â§ pref s uid PID â  Conflict â§ phase s cid â¥ revPH)"
  using 0 1 s by (metis not_le paperIDs_equals)
  thus ?thesis using assms unfolding T.simps Ï_def2 by (force simp add: c_defs)
qed

lemma T_Ï_Î³_1:
assumes s: "reachNT s" and s1: "reach s1" and PID: "PID ââ paperIDs s cid"
and ss1: "eqExcPID2 s s1"
and step1: "step s1 a = (ou1,s1')" and Ï1: "Ï (Trans s1 a ou1 s1')"
and Ï: "Â¬ Ï (Trans s a ou s')"
shows "Â¬ Î³ (Trans s1 a ou1 s1')"
proof-
  have "â uid â UIDs. isChair s cid uid â¶ pref s uid PID = Conflict â¨ phase s cid < revPH"
  using reachNT_non_isPC_isChair[OF s] PID by auto
  hence 1: "â uid â UIDs. isChair s1 cid uid â¶ pref s1 uid PID = Conflict â¨ phase s1 cid < revPH"
  using ss1 unfolding eqExcPID2_def using eqExcRLR_imp2 by fastforce
  have PID1: "PID ââ paperIDs s1 cid" using PID ss1 eqExcPID2_imp by auto
  show ?thesis apply(rule T_Ï_Î³_stronger[OF s1 PID1 step1 Ï1]) using 1 by auto
qed

lemma notInPaperIDs_eqExLRL_roles_eq:
assumes s: "reach s" and s1: "reach s1" and PID: "Â¬ PID ââ paperIDs s cid"
and eq: "eqExcPID2 s s1"
shows "roles s cid uid = roles s1 cid uid"
proof-
  have "Â¬ PID ââ paperIDs s1 cid" using PID eq unfolding eqExcPID2_def by auto
  hence "Â¬ isRev s cid uid PID â§ Â¬ isRev s1 cid uid PID" using s s1 PID by (metis isRev_paperIDs)
  thus ?thesis using eq unfolding eqExcPID2_def eqExcRLR_def
  by (metis Bex_set_list_ex filter_True isRev_def)
qed


(* major *) lemma eqExcPID2_step_out:
assumes ss1: "eqExcPID2 s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and sT: "reachNT s" and s1: "reach s1"
and PID: "PID ââ paperIDs s cid" and ph: "phase s cid â¥ revPH"
and Ï: "Â¬ Ï (Trans s a ou s')" and Ï1: "Â¬ Ï (Trans s1 a ou1 s1')"
and UIDs: "userOfA a â UIDs"
shows "ou = ou1"
proof-
  note s = reachNT_reach[OF sT]
  have s': "reach s'" and s1': "reach s1'" by (metis reach_PairI s s1 step step1)+
  have s's1': "eqExcPID2 s' s1'" by (metis PID Ï eqExcPID2_step ph s ss1 step step1)
  note Inv = reachNT_non_isPC_isChair[OF sT UIDs]
  note eqs = eqExcPID2_imp[OF ss1]
  note eqs' = eqExcPID2_imp1[OF ss1]

  note simps[simp] = c_defs u_defs uu_defs r_defs l_defs Paper_dest_conv eqExcPID2_def
  note simps2[simp] = eqExcRLR_imp[of s _ _ _ s1, OF s] eqExcRLR_imp[of s' _ _ _ s1']
                eqExcRLR_imp[of s _ _ _ s1'] eqExcRLR_imp[of s' _ _ _ s1]
      eqExcRLR_imp2[of s _ _ s1] eqExcRLR_imp2[of s' _ _ s1']
                eqExcRLR_imp2[of s _ _ s1'] eqExcRLR_imp2[of s' _ _ s1]
      eqExcRLR_set[of "(roles s cid uid)" "(roles s1 cid uid)" for cid uid]
      eqExcRLR_set[of "(roles s cid uid)" "(roles s1' cid uid)" for cid uid]
      eqExcRLR_set[of "(roles s' cid uid)" "(roles s1 cid uid)" for cid uid]
      eqExcRLR_set[of "(roles s' cid uid)" "(roles s1' cid uid)" for cid uid]
      foo2 foo3
      eqExcRLR_imp_isRevRole_imp

  {fix cid uid p pid assume "a = Ract (rMyReview cid uid p pid)"
   hence ?thesis
   using step step1 eqs eqs' s s1 UIDs PID Ï Ï1 ph
    paperIDs_equals[OF s] Inv
   apply (auto simp add: isRev_getRevRole getRevRole_Some)[]
   apply (metis eqExcPID2_imp' isRev_isPC not_less option.inject pref_Conflict_isRev role.distinct role.inject ss1
                isRev_isPC not_less pref_Conflict_isRev simps2(1) simps2(8) isRev_getRevRole getRevRole_Some)+
   done
  } note this[simp]

  {fix cid uid p pid assume "a = Ract (rFinalDec cid uid p pid)"
   hence ?thesis
   apply(cases "pid = PID")
   using step step1 eqs eqs' s s1 UIDs PID Ï Ï1 ph
   paperIDs_equals[OF s] Inv using eeqExcPID_RDD by fastforce+
  } note this[simp]

  show ?thesis
    using step step1 eqs eqs' s s1 UIDs PID Ï Ï1 ph
    paperIDs_equals[OF s] Inv
    apply(cases a)
      subgoal for x1 by (cases x1; auto)
      subgoal for x2 apply(cases x2)
        subgoal by auto
        subgoal by auto
        subgoal by auto
        subgoal by auto
        subgoal by auto
        subgoal by auto
        subgoal apply clarsimp
          subgoal by (metis eqExcPID2_imp' isRev_pref_notConflict_isPC nat_neq_iff simps2(7) ss1)
          subgoal by (metis isRev_pref_notConflict_isPC nat_neq_iff simps2(1)) . .
      subgoal for x3 apply(cases x3)
        subgoal by auto
        subgoal by auto
        subgoal apply clarsimp
          subgoal by (metis isRev_pref_notConflict_isPC le_antisym less_imp_le_nat n_not_Suc_n simps2(1) simps2(5))
          subgoal by (metis isRev_pref_notConflict_isPC le_antisym less_imp_le_nat n_not_Suc_n simps2(1)) .
        subgoal by auto .
      subgoal for x4 apply(cases x4)
        subgoal by auto
        subgoal by auto
        subgoal by auto
        subgoal by auto
        subgoal by clarsimp (metis eqExcPID2_RDD ss1)
        subgoal apply clarsimp
          subgoal by (metis eqExcPID2_RDD ss1)
          subgoal by auto .
        subgoal by auto
        subgoal by auto
        subgoal by clarsimp (metis eqExcPID2_imp2 less_imp_le_nat not_less_eq_eq ss1)
        subgoal by clarsimp (metis less_imp_le_nat not_less_eq_eq)
        subgoal by clarsimp (metis discussion.inject less_imp_le_nat not_less_eq_eq)
        subgoal by clarsimp (metis (mono_tags, lifting) Suc_le_lessD not_less_eq)
        subgoal by auto
        subgoal by clarsimp linarith .
      subgoal for x5 apply(cases x5)
        subgoal by auto
        subgoal by auto
        subgoal by auto
        subgoal by clarsimp (metis (no_types, opaque_lifting) empty_iff list.set(1)
                           notInPaperIDs_eqExLRL_roles_eq notIsPC_eqExLRL_roles_eq simps2(5) ss1)
        subgoal by auto
        subgoal by auto
        subgoal by auto
        subgoal by auto
        subgoal by auto
        subgoal by auto
        subgoal by clarsimp (smt Suc_le_lessD eqExcRLR_imp filter_cong isRev_pref_notConflict_isPC not_less_eq)
        subgoal by clarsimp (metis Suc_le_lessD eqExcPID2_imp' not_less_eq ss1) .
    done
qed

definition Î1 :: "state â value list â state â value list â bool" where
"Î1 s vl s1 vl1 â¡
 (â cid. PID ââ paperIDs s cid â¶ phase s cid < revPH) â§ s = s1
 â§ B vl vl1"

definition Î2 :: "state â value list â state â value list â bool" where
"Î2 s vl s1 vl1 â¡
 â cid uid.
   PID ââ paperIDs s cid â§ phase s cid = revPH â§
   isChair s cid uid â§ pref s uid PID â  Conflict â§
   eqExcPID2 s s1 â§
   distinct (map fst vl1) â§
   fst ` (set vl1) â {uid'. isPC s cid uid' â§ pref s uid' PID â  Conflict} â§
   fst ` (set vl1) â© {uid'. isRev s1 cid uid' PID} = {} â§
   snd ` (set vl1) â {{uid'. isPC s cid uid' â§ pref s uid' PID â  Conflict}}"

definition Î3 :: "state â value list â state â value list â bool" where
"Î3 s vl s1 vl1 â¡
 â cid. PID ââ paperIDs s cid â§ phase s cid > revPH â§ eqExcPID2 s s1 â§ vl1 = []"

definition Îe :: "state â value list â state â value list â bool" where
"Îe s vl s1 vl1 â¡
 vl â  [] â§
 (
  (â cid. PID ââ paperIDs s cid â§ phase s cid â¥ revPH â§
          Â¬ (â uid. isChair s cid uid â§ pref s uid PID â  Conflict))
  â¨
  (â cid. PID ââ paperIDs s cid â§ phase s cid â¥ revPH â§
          snd (hd vl) â  {uid'. isPC s cid uid' â§ pref s uid' PID â  Conflict})
  â¨
  (â cid. PID ââ paperIDs s cid â§ phase s cid > revPH)
 )"

lemma istate_Î1:
assumes B: "B vl vl1"
shows "Î1 istate vl istate vl1"
using B unfolding Î1_def B_def istate_def by auto

lemma unwind_cont_Î1: "unwind_cont Î1 {Î1,Î2,Îe}"
proof(rule, simp)
  let ?Î = "Î»s vl s1 vl1. Î1 s vl s1 vl1 â¨ Î2 s vl s1 vl1 â¨ Îe s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Î1 s vl s1 vl1"
  hence rs: "reach s" and ss1: "s1 = s" and B: "B vl vl1"
  and c_d: "distinct (map fst vl1) â§ fst ` (set vl1) â snd (hd vl) â§ snd ` (set vl1) = {snd (hd vl)}"
  and vl: "vl â  []"
  and PID_ph: "â cid. PID ââ paperIDs s cid â¹ phase s cid < revPH"
  using reachNT_reach unfolding Î1_def B_def by auto
  have rv: "â cid. Â¬ (â uid'. isRev s cid uid' PID)" using rs PID_ph
  by (metis isRev_geq_revPH isRev_paperIDs less_Suc_eq_le not_less_eq_eq)
  show "iaction ?Î s vl s1 vl1 â¨
        ((vl = [] â¶ vl1 = []) â§ reaction ?Î s vl s1 vl1)" (is "?iact â¨ (_ â§ ?react)")
  proof-
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"  let ?trn1 = "Trans s1 a ou s'"
      assume step: "step s a = (ou, s')" and T: "Â¬ T ?trn" and c: "consume ?trn vl vl'"
      have Ï: "Â¬ Ï ?trn" 
        apply(cases a)
        subgoal for x1 apply(cases x1) using step PID_ph by (fastforce simp: c_defs)+
        by simp_all
      hence vl': "vl' = vl" using c unfolding consume_def by auto
      show "match ?Î s s1 vl1 a ou s' vl' â¨ ignore ?Î s s1 vl1 a ou s' vl'" (is "?match â¨ ?ignore")
      proof-
        have ?match proof
          show "validTrans ?trn1" unfolding ss1 using step by simp
        next
          show "consume ?trn1 vl1 vl1" unfolding consume_def ss1 using Ï by auto
        next
          show "Î³ ?trn = Î³ ?trn1" unfolding ss1 by simp
        next
          assume "Î³ ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
        next
          show "?Î s' vl' s' vl1"
          proof(cases "â cid. PID ââ paperIDs s cid")
            case False note PID = False
            have PID_ph': "â cid. PID ââ paperIDs s' cid â¹ phase s' cid < revPH" using PID step rs
              apply(cases a)
              subgoal for _ x1 apply(cases x1) apply(fastforce simp: c_defs)+ .
              subgoal for _ x2 apply(cases x2) apply(fastforce simp: u_defs)+ .
              subgoal for _ x3 apply(cases x3) apply(fastforce simp: uu_defs)+ .
              by auto
            hence "Î1 s' vl' s' vl1" unfolding Î1_def B_def vl' using PID_ph' c_d vl by auto
            thus ?thesis by auto
          next
            case True
            then obtain CID where PID: "PID ââ paperIDs s CID" by auto
            hence ph: "phase s CID < revPH" using PID_ph by auto
            have PID': "PID ââ paperIDs s' CID" by (metis PID paperIDs_mono step)
            show ?thesis
            proof(cases "phase s' CID < revPH")
              case True note ph' = True
              hence "Î1 s' vl' s' vl1" unfolding Î1_def B_def vl' using vl c_d ph' PID' apply auto
              by (metis reach_PairI paperIDs_equals rs step)
              thus ?thesis by auto
            next
              case False
              hence ph_rv': "phase s' CID = revPH â§ Â¬ (â uid'. isRev s' CID uid' PID)"
              using ph PID step rs rv
                apply(cases a)
                subgoal for x1 apply(cases x1) apply(fastforce simp: c_defs)+ .
                subgoal for x2 apply(cases x2) apply(fastforce simp: u_defs isRev_def2)+ .
                subgoal for x3 apply(cases x3) apply(fastforce simp: uu_defs)+ .
                by auto
              show ?thesis
              proof(cases "(â uid. isChair s' CID uid â§ pref s' uid PID â  Conflict) â§
                           snd (hd vl) = {uid'. isPC s' CID uid' â§ pref s' uid' PID â  Conflict}")
                case True
                hence "Î2 s' vl' s' vl1"
                unfolding Î2_def B_def vl' using c_d ph_rv' PID' by auto
                thus ?thesis by auto
              next
                case False
                hence "Îe s' vl' s' vl1"
                unfolding Îe_def vl' using vl c_d ph_rv' PID' by auto
                thus ?thesis by auto
              qed
            qed
          qed
        qed
        thus ?thesis by simp
      qed
    qed
    thus ?thesis using vl by auto
  qed
qed

lemma unwind_cont_Î2: "unwind_cont Î2 {Î2,Î3,Îe}"
proof(rule, simp)
  let ?Î = "Î»s vl s1 vl1. Î2 s vl s1 vl1 â¨ Î3 s vl s1 vl1 â¨ Îe s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Î2 s vl s1 vl1"
  then obtain CID uid where uid: "isChair s CID uid â§ pref s uid PID â  Conflict"
  and rs: "reach s" and ph: "phase s CID = revPH" (is "?ph = _") and ss1: "eqExcPID2 s s1"
  and PID: "PID ââ paperIDs s CID"
  and dis: "distinct (map fst vl1)"
  and fst_isPC: "fst ` (set vl1) â {uid'. isPC s CID uid' â§ pref s uid' PID â  Conflict}"
  and fst_isRev: "fst ` (set vl1) â© {uid'. isRev s1 CID uid' PID} = {}"
  and snd_isPC: "snd ` (set vl1) â {{uid'. isPC s CID uid' â§ pref s uid' PID â  Conflict}}"
  using reachNT_reach unfolding Î2_def by auto
  hence uid_notin: "uid â UIDs"
    using reachNT_non_isPC_isChair rsT by fastforce
  note vl1_all = dis fst_isPC fst_isRev snd_isPC
  show "iaction ?Î s vl s1 vl1 â¨
        ((vl = [] â¶ vl1 = []) â§ reaction ?Î s vl s1 vl1)" (is "?iact â¨ (_ â§ ?react)")
  proof(cases vl1)
    case (Cons v1 vl1') note vl1 = Cons
    obtain uid' where v1: "v1 = (uid', {uid'. isPC s CID uid' â§ pref s uid' PID â  Conflict})"
    using snd_isPC unfolding vl1 by(cases v1) auto
    hence uid': "isPC s CID uid' â§ pref s uid' PID â  Conflict"
    and uid'1: "Â¬ isRev s1 CID uid' PID"
    using fst_isPC fst_isRev unfolding vl1 by auto
    have uid1: "isChair s1 CID uid â§ pref s1 uid PID â  Conflict"
    using ss1 uid unfolding eqExcPID2_def using eqExcRLR_imp2 by metis
    define a1 where "a1 â¡ Cact (cReview CID uid (pass s uid) PID uid')"
    obtain s1' ou1 where step1: "step s1 a1 = (ou1,s1')" by (metis prod.exhaust)
    let ?trn1 = "Trans s1 a1 ou1 s1'"
    have s1s1': "eqExcPID2 s1 s1'" using a1_def step1 cReview_step_eqExcPID2 by blast
    have ss1': "eqExcPID2 s s1'" using eqExcPID2_trans[OF ss1 s1s1'] .
    hence many_s1': "PID ââ paperIDs s1' CID" "isChair s1' CID uid â§ pref s1' uid PID â  Conflict"
    "phase s1' CID = revPH" "pass s1' uid = pass s uid"
    "isPC s1' CID uid' â§ pref s1' uid' PID â  Conflict"
    using uid' uid PID ph unfolding eqExcPID2_def using eqExcRLR_imp2 apply auto by metis+
    hence more_s1': "uid ââ userIDs s1'" "CID ââ confIDs s1'"
    by (metis paperIDs_confIDs reach_PairI roles_userIDs rs1 step1 many_s1'(1))+
    have ou1: "ou1 = outOK" using step1 unfolding a1_def apply ( simp add: c_defs)
    using more_s1' many_s1' uid'1 by (metis roles_userIDs rs1)
    have f: "f ?trn1 = v1" unfolding a1_def v1 apply simp
    using ss1 unfolding eqExcPID2_def using eqExcRLR_imp2
    by (metis eqExcRLR_set isRevRoleFor.simps(3))
    have rs1': "reach s1'" using rs1 step1 by (auto intro: reach_PairI)
    have ?iact proof
      show "step s1 a1 = (ou1,s1')" by fact
    next
      show Ï: "Ï ?trn1" using ou1 unfolding a1_def by simp
      thus "consume ?trn1 vl1 vl1'" using f unfolding consume_def vl1 by simp
    next
      show "Â¬ Î³ ?trn1" by (simp add: a1_def uid_notin)
    next
      have "{uid'. isRev s1' CID uid' PID} â insert uid' {uid'. isRev s1 CID uid' PID}"
      using step1 unfolding a1_def ou1 by (auto simp add: c_defs isRev_def2 )
      hence "fst ` set vl1' â© {uid'. isRev s1' CID uid' PID} = {}"
      using fst_isRev dis unfolding vl1 v1 by auto
      hence "Î2 s vl s1' vl1'" unfolding Î2_def
      using PID ph ss1' uid using vl1_all unfolding vl1 by auto
      thus "?Î s vl s1' vl1'" by simp
    qed
    thus ?thesis by auto
  next
    case Nil note vl1 = Nil
    have ?react proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      let ?ph' = "phase s' CID"
      assume step: "step s a = (ou, s')" and T: "Â¬ T ?trn" and c: "consume ?trn vl vl'"
      have PID': "PID ââ paperIDs s' CID" using PID rs by (metis paperIDs_mono step)
      have uid': "isChair s' CID uid â§ pref s' uid PID â  Conflict"
      using uid step rs ph PID isChair_persistent revPH_pref_persists[OF rs PID ] by auto
      have all_vl1':
      "fst ` (set vl1) â {uid'. isPC s' CID uid' â§ pref s' uid' PID â  Conflict}"
      and "snd ` (set vl1) â {{uid'. isPC s' CID uid' â§ pref s' uid' PID â  Conflict}}"
      using vl1_all
      apply (metis (full_types) empty_subsetI image_empty set_empty vl1)
      by (metis (lifting, no_types) empty_set image_is_empty subset_insertI vl1)
      show "match ?Î s s1 vl1 a ou s' vl' â¨ ignore ?Î s s1 vl1 a ou s' vl'" (is "?match â¨ ?ignore")
      proof(cases "Ï ?trn")
        case False note Ï = False
        have vl: "vl' = vl" using c Ï unfolding consume_def by (cases vl) auto
        obtain ou1 and s1' where step1: "step s1 a = (ou1,s1')" by (metis prod.exhaust)
        let ?trn1 = "Trans s1 a ou1 s1'"
        have s's1': "eqExcPID2 s' s1'" using eqExcPID2_step[OF rs ss1 step step1 PID] ph Ï by auto
        show ?thesis
        proof(cases "ou = outErr â§ Â¬ Î³ ?trn")
          case True note ou = True[THEN conjunct1] and Î³ = True[THEN conjunct2]
          have s': "s' = s" using step ou by (metis step_outErr_eq)
          have ?ignore proof
            show "Â¬ Î³ ?trn" by fact
          next
            show "?Î s' vl' s1 vl1"
            proof(cases "?ph' = revPH")
              case True
              hence "Î2 s' vl' s1 vl1" using ss1 PID' uid' vl1_all unfolding Î2_def vl1 s' by auto
              thus ?thesis by auto
            next
              case False hence ph': "?ph' > revPH" using ph rs step s' by blast
              show ?thesis
              proof(cases vl')
                case Nil
                hence "Î3 s' vl' s1 vl1" using ss1 PID' ph' unfolding Î3_def vl1 s' by auto
                thus ?thesis by auto
              next
                case Cons
                hence "Îe s' vl' s1 vl1" using PID' ph' unfolding Îe_def by auto
                thus ?thesis by auto
              qed
            qed
          qed
          thus ?thesis by auto
        next
          case False note ou_Î³ = False
          have Ï1: "Â¬ Ï ?trn1"
          using non_eqExcPID2_step_Ï_imp[OF rs ss1 PID _ step step1 Ï]
                T_Ï_Î³_1[OF rsT rs1 PID ss1 step1 _ Ï] ou_Î³ by auto
          have ?match
          proof
            show "validTrans ?trn1" using step1 by simp
          next
            show "consume ?trn1 vl1 vl1" unfolding consume_def using Ï1 by auto
          next
            show "Î³ ?trn = Î³ ?trn1" unfolding ss1 by simp
          next
            assume "Î³ ?trn" thus "g ?trn = g ?trn1"
            using eqExcPID2_step_out[OF ss1 step step1 rsT rs1 PID _ Ï Ï1] ph by simp
          next
            show "?Î s' vl' s1' vl1"
            proof(cases "?ph' = revPH")
              case True note ph' = True
              hence "Î2 s' vl' s1' vl1" using PID' s's1' uid' ph' vl1_all unfolding Î2_def vl1 by auto
              thus ?thesis by auto
            next
              case False hence ph': "?ph' > revPH" using ph rs step by (metis antisym_conv2 phase_increases)
              show ?thesis
              proof(cases vl')
                case Nil
                hence "Î3 s' vl' s1' vl1" using s's1' PID' ph' unfolding Î3_def vl1 by auto
                thus ?thesis by auto
              next
                case Cons
                hence "Îe s' vl' s1' vl1" using PID' ph' unfolding Îe_def by auto
                thus ?thesis by auto
              qed
            qed
          qed
          thus ?thesis by simp
        qed
      next
        case True note Ï = True
        have s's: "eqExcPID2 s' s" using eqExcPID2_sym using Ï_step_eqExcPID2[OF Ï step]  .
        have s's1: "eqExcPID2 s' s1" using eqExcPID2_trans[OF s's ss1] .
        have ?ignore proof
          show "Â¬ Î³ ?trn" using T_Ï_Î³ Ï rsT step by auto
        next
          show "?Î s' vl' s1 vl1"
          proof(cases "?ph' = revPH")
            case True
            hence "Î2 s' vl' s1 vl1" using s's1 PID' uid' vl1_all unfolding Î2_def vl1 by auto
            thus ?thesis by auto
          next
            case False hence ph': "?ph' > revPH" using ph rs step by (metis antisym_conv2 phase_increases)
            show ?thesis
            proof(cases vl')
                case Nil
                hence "Î3 s' vl' s1 vl1" using s's1 PID' ph' unfolding Î3_def vl1 by auto
                thus ?thesis by auto
              next
                case Cons
                hence "Îe s' vl' s1 vl1" using PID' ph' unfolding Îe_def by auto
                thus ?thesis by auto
              qed
            qed
          qed
          thus ?thesis by auto
        qed
      qed
      thus ?thesis using vl1 by auto
    qed
qed


lemma unwind_cont_Î3: "unwind_cont Î3 {Î3,Îe}"
proof(rule, simp)
  let ?Î = "Î»s vl s1 vl1. Î3 s vl s1 vl1 â¨ Îe s vl s1 vl1"
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and "Î3 s vl s1 vl1"
  then obtain CID where rs: "reach s" and ph: "phase s CID > revPH" (is "?ph > _")
  and PID: "PID ââ paperIDs s CID" and ss1: "eqExcPID2 s s1"
  and vl1: "vl1 = []"
  using reachNT_reach unfolding Î3_def by auto
  show "iaction ?Î s vl s1 vl1 â¨
        ((vl = [] â¶ vl1 = []) â§ reaction ?Î s vl s1 vl1)" (is "?iact â¨ (_ â§ ?react)")
  proof-
    have "?react"
    proof
      fix a :: act and ou :: out and s' :: state and vl'
      let ?trn = "Trans s a ou s'"
      let ?ph' = "phase s' CID"
      assume step: "step s a = (ou, s')" and T: "Â¬ T ?trn" and c: "consume ?trn vl vl'"
      have PID': "PID ââ paperIDs s' CID" using PID rs by (metis paperIDs_mono step)
      have ph': "phase s' CID > revPH" using ph rs by (meson less_le_trans local.step phase_increases)
      show "match ?Î s s1 vl1 a ou s' vl' â¨ ignore ?Î s s1 vl1 a ou s' vl'" (is "?match â¨ ?ignore")
      proof(cases "Ï ?trn")
        case False note Ï = False
        have vl': "vl' = vl" using c Ï unfolding consume_def by (cases vl) auto
        obtain ou1 and s1' where step1: "step s1 a = (ou1,s1')" by (metis prod.exhaust)
        let ?trn1 = "Trans s1 a ou1 s1'"
        have s's1': "eqExcPID2 s' s1'" using eqExcPID2_step[OF rs ss1 step step1 PID] ph Ï by auto
        have Ï1: "Â¬ Ï ?trn1" using Ï unfolding eqExcPID2_step_Ï[OF rs rs1 ss1 PID ph step step1] .
        have ?match proof
          show "validTrans ?trn1" using step1 by simp
        next
          show "consume ?trn1 vl1 vl1" unfolding consume_def using Ï1 by auto
        next
          show "Î³ ?trn = Î³ ?trn1" unfolding ss1 by simp
        next
          assume "Î³ ?trn" thus "g ?trn = g ?trn1"
          using eqExcPID2_step_out[OF ss1 step step1 rsT rs1 PID _ Ï Ï1] ph by simp
        next
          have "Î3 s' vl' s1' vl1" using ph' PID' s's1' unfolding Î3_def vl1 by auto
          thus "?Î s' vl' s1' vl1" by simp
        qed
        thus ?thesis by simp
      next
        case True note Ï = True
        have s's: "eqExcPID2 s' s" using eqExcPID2_sym[OF Ï_step_eqExcPID2[OF Ï step]] .
        have s's1: "eqExcPID2 s' s1" using eqExcPID2_trans[OF s's ss1] .
        have ?ignore proof
          show "Â¬ Î³ ?trn" using T_Ï_Î³ Ï rsT step by auto
        next
          have "Î3 s' vl' s1 vl1" using s's1 PID' ph' vl1 unfolding Î3_def by auto
          thus "?Î s' vl' s1 vl1" by auto
        qed
        thus ?thesis by simp
      qed
    qed
    thus ?thesis using vl1 by simp
  qed
qed


(* Exit arguments: *)
definition K1exit where
"K1exit cid s â¡ PID ââ paperIDs s cid â§ phase s cid â¥ revPH â§
                Â¬ (â uid. isChair s cid uid â§ pref s uid PID â  Conflict)"

lemma invarNT_K1exit: "invarNT (K1exit cid)"
  unfolding invarNT_def
  apply (safe dest!: reachNT_reach)
  subgoal for _ a apply(cases a)
    subgoal for x1 apply(cases x1) apply (fastforce simp add: c_defs K1exit_def geq_noPH_confIDs)+ .
    subgoal for x2 apply(cases x2) apply (auto simp add: u_defs K1exit_def paperIDs_equals)
      apply (metis less_eq_Suc_le less_not_refl paperIDs_equals) .
    subgoal for x3 apply(cases x3) apply (auto simp add: uu_defs K1exit_def) .
    by auto
  done

lemma noVal_K1exit: "noVal (K1exit cid) v"
  apply(rule noÏ_noVal)
  unfolding noÏ_def
  apply safe
  subgoal for _ a apply(cases a)
    subgoal for x1 apply(cases x1)
      apply (auto simp add: c_defs K1exit_def)
      by (metis paperIDs_equals reachNT_reach)
    by auto
  done

definition K2exit where
"K2exit cid s v â¡
 PID ââ paperIDs s cid â§ phase s cid â¥ revPH â§
 snd v â  {uid'. isPC s cid uid' â§ pref s uid' PID â  Conflict}"

lemma revPH_isPC_constant:
assumes s: "reach s"
and "step s a = (ou,s')"
and "pid ââ paperIDs s cid" and "phase s cid â¥ revPH"
shows "isPC s' cid uid' = isPC s cid uid'"
  using assms
  apply(cases a)
  subgoal for x1 apply(cases x1)
           apply (auto simp add: c_defs)
    by (metis paperIDs_confIDs)
  subgoal for x2 apply(cases x2) apply (auto simp add: u_defs) .
  subgoal for x3 apply(cases x3) apply (auto simp add: uu_defs) .
  by auto

lemma revPH_pref_constant:
assumes s: "reach s"
and "step s a = (ou,s')"
and "pid ââ paperIDs s cid" and "phase s cid â¥ revPH"
shows "pref s' uid pid = pref s uid pid"
  using assms
  apply(cases a)
  subgoal for x1 apply(cases x1)
           apply (auto simp add: c_defs)
      apply (metis paperIDs_getAllPaperIDs)
     apply (metis Suc_n_not_le_n le_SucI paperIDs_equals)
    apply (metis Suc_n_not_le_n le_SucI paperIDs_equals) .
  subgoal for x2 apply(cases x2)
          apply (auto simp add: u_defs)
    apply (metis Suc_n_not_le_n paperIDs_equals) .
  subgoal for x3 apply(cases x3) apply (auto simp add: uu_defs) .
  by auto

lemma invarNT_K2exit: "invarNT (Î» s. K2exit cid s v)"
unfolding invarNT_def apply (safe dest!: reachNT_reach)
unfolding K2exit_def
by (smt Collect_cong le_trans paperIDs_mono phase_increases revPH_isPC_constant revPH_pref_constant)

(* An even more interesting invariant than the one in Review_Confidentiality/RAut:
it requires the binary version noVal2  *)
lemma noVal_K2exit: "noVal2 (K2exit cid) v"
  unfolding noVal2_def
  apply safe
  subgoal for _ a apply(cases a)
    subgoal for x1 apply(cases x1)
             apply (auto simp add: c_defs K2exit_def)
      by (metis paperIDs_equals reachNT_reach)+
    by auto
  done

definition K3exit where
"K3exit cid s â¡ PID ââ paperIDs s cid â§ phase s cid > revPH"

lemma invarNT_K3exit: "invarNT (K3exit cid)"
  unfolding invarNT_def
  apply (safe dest!: reachNT_reach)
  subgoal for _ a apply(cases a)
    subgoal for x1 apply(cases x1) apply (auto simp add: c_defs K3exit_def) .
    subgoal for x2 apply(cases x2) apply (auto simp add: u_defs K3exit_def) .
    subgoal for x3 apply(cases x3) apply (auto simp add: uu_defs K3exit_def) .
    by auto
  done

lemma noVal_K3exit: "noVal (K3exit cid) v"
  apply(rule noÏ_noVal)
  unfolding noÏ_def
  apply safe
  subgoal for _ a apply(cases a)
    subgoal for x1 apply(cases x1)
             apply (auto simp add: c_defs K3exit_def)
      using paperIDs_equals reachNT_reach by fastforce
    by auto
  done


lemma unwind_exit_Îe: "unwind_exit Îe"
proof
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and Îe: "Îe s vl s1 vl1"
  hence vl: "vl â  []" using reachNT_reach unfolding Îe_def by auto
  then obtain CID where "K1exit CID s â¨ K2exit CID s (hd vl) â¨ K3exit CID s"
  using Îe unfolding K1exit_def K2exit_def K3exit_def Îe_def by auto
  thus "vl â  [] â§ exit s (hd vl)" apply(simp add: vl)
  by (metis exitI2 exitI2_noVal2 invarNT_K1exit invarNT_K2exit invarNT_K3exit
            noVal_K1exit noVal_K2exit noVal_K3exit rsT)
qed

theorem secure: secure
apply(rule unwind_decomp3_secure[of Î1 Î2 Îe Î3])
using
istate_Î1
unwind_cont_Î1 unwind_cont_Î2 unwind_cont_Î3
unwind_exit_Îe
by auto

end

Theory Traceback_Properties

theory Traceback_Properties
imports Safety_Properties
begin


section â¹Traceback propertiesâº

text â¹In this section, we prove various traceback properties,
by essentially giving trace-based justifications of certain
occurring situations that are relevant for access to information:
%
\begin{description}
\item{\bf Being an author. }
If a user is an author of a paper, then either the user has registered the paper in the first
place or, inductively, has been appointed as coauthor by another author.
%
\item{\bf Being a chair. }
If a user is a chair of a conference, then either that user has registered the conference
which has been approved by the superuser or, inductively, that user has been appointed
by an existing chair of that conference.
%
%
\item{\bf Being a PC member. }
If a user is a PC member in a conference, then the user either must have been the original chair or must
have been appointed by a chair.
%
\item{\bf Being a reviewer. }
If a user is a paper's reviewer, then the user must have been appointed by a chair (from
among the PC members who have not declared a conflict with the paper).
%
\item{\bf Having conflict. }
If a user has conflict with a paper, then the user is either an author of the paper or the
conflict has been declared by that user or by a paper's author, in such a way that between
the moment when the conflict has been last declared and the current moment there is no
transition that successfully removes the conflict.
%
\item{\bf Conference reaching a phase. }
If a conference is in a given phase different from ``no phase'', then this has happened as
a consequence of either a conference approval action by the superuser (if the phase is
Setup) or a phase change action by a chair (otherwise).
\end{description}

More details and explanations can be found in \cite[Section 3.6]{cocon-JAR2021}.
âº


subsection â¹Preliminariesâº

inductive trace_between :: "state â (state,act,out) trans trace â state â bool" where
  empty[simp]: "trace_between s [] s"
| step: "â¦trace_between s tr sh; step sh a = (ou,s')â§ â¹ trace_between s (tr@[Trans sh a ou s']) s'"

inductive_simps
  trace_ft_empty[simp]: "trace_between s [] s'" and
  trace_ft_snoc: "trace_between s (tr@[trn]) s'"
thm trace_ft_empty trace_ft_snoc

lemma trace_ft_append: "trace_between s (tr1@tr2) s'
  â· (âsh. trace_between s tr1 sh â§ trace_between sh tr2 s')"
  apply (induction tr2 arbitrary: s' rule: rev_induct)
   apply simp
  apply (subst append_assoc[symmetric], subst trace_ft_snoc)
  apply (auto simp: trace_ft_snoc)
  done

lemma trace_ft_Cons: "trace_between s (trn#tr) s'
  â· (âsh ou a. trn = Trans s a ou sh â§ step s a = (ou,sh) â§ trace_between sh tr s')"
  apply (subst trace_ft_append[where ?tr1.0 = "[trn]", simplified])
  apply (subst trace_ft_snoc[where tr = "[]", simplified])
  by auto

lemmas trace_ft_simps = trace_ft_empty trace_ft_snoc trace_ft_Cons trace_ft_append

inductive trace_to :: " (state,act,out) trans trace â state â bool" where
  empty: "trace_to [] istate"
| step: "â¦trace_to tr s; step s a = (ou,s')â§ â¹ trace_to (tr@[Trans s a ou s']) s'"

lemma trace_to_ft: "trace_to tr s â· trace_between istate tr s"
proof (rule,goal_cases)
  case 1 thus ?case
    by induction (auto intro: trace_between.intros)
next
  case 2
  moreover
  {fix s' assume "trace_between s' tr s" hence "s' = istate â¶ trace_to tr s"
   by induction (auto intro: trace_to.intros)
  }
  ultimately show ?case by auto
qed

inductive_simps trace_to_empty[simp]: "trace_to [] s"

lemma trace_to_reach: assumes "trace_to tr s" shows "reach s"
  using assms apply induction
   apply (rule reach.intros)
  by (metis reach_step snd_conv)

lemma reach_to_trace: assumes "reach s" obtains tr where "trace_to tr s"
  using assms apply (induction rule: reach_step_induct)
   apply (auto intro: trace_to.intros) []
  by (metis surjective_pairing trace_to.step)

lemma reach_trace_to_conv: "reach s â· (âtr. trace_to tr s)"
  by (blast intro: trace_to_reach elim: reach_to_trace)

thm trace_to.induct[no_vars]

lemma trace_to_induct[case_names empty step, induct set]:
  "â¦trace_to x1 x2; P [] istate;
  âtr s a ou s'.
    â¦trace_to tr s; P tr s; reach s; reach s'; step s a = (ou, s')â§
    â¹ P (tr ## Trans s a ou s') s'â§
  â¹ P x1 x2"
  apply (erule trace_to.induct)
   apply simp
  apply (frule trace_to_reach)
  using reach_PairI by blast



subsection â¹Authorshipâº

text â¹
  Only the creator of a paper, and users explicitly added by other authors,
  are authors of a paper.
âº

inductive isAut' :: "(state,act,out) trans trace â confID â userID â paperID â bool" where
  creator: "â¦ trn = Trans _ (Cact (cPaper cid uid _ pid _ _)) outOK _ â§
    â¹ isAut' (tr@[trn]) cid uid pid"
  (* "The creator of a paper is an author"  *)
| co_author: "â¦
  isAut' tr cid uid' pid;
  trn = Trans _ (Cact (cAuthor cid uid' _ pid uid)) outOK _ â§
  â¹ isAut' (tr@[trn]) cid uid pid"
  (* "An author can add any other user as a coauthor" *)
| irrelevant: "isAut' tr cid uid' pid â¹ isAut' (tr@[_]) cid uid' pid"

lemma justify_author:
  assumes "trace_to tr s"
  assumes "isAut s cid uid pid"
  shows "isAut' tr cid uid pid"
  using assms
proof (induction arbitrary: uid)
  case (empty s) thus ?case
    by (auto simp add: istate_def)
next
  case (step tr s a ou s')
  show ?case
  proof (cases "isAut s cid uid pid")
    case True with step.IH show ?thesis by (blast intro: isAut'.intros)
  next
    case False
    with step.hyps step.prems obtain
      pass s1 s2 uid' where
      "a=Cact (cPaper cid uid pass pid s1 s2)
      â¨ (a=Cact (cAuthor cid uid' pass pid uid) â§ isAut s cid uid' pid)"
      and [simp]: "ou=outOK"
      apply (cases a)
        subgoal for x1 apply (cases x1, auto simp add: c_defs) [] .
        subgoal for x2 apply (cases x2, auto simp add: u_defs) [] .
        subgoal for x3 apply (cases x3, auto simp add: uu_defs) [] .
        by simp_all
    thus ?thesis using step.IH
      apply (elim disjE)
      apply (rule isAut'.creator, auto) []
      apply (rule isAut'.co_author, auto) []
      done
  qed
qed


lemma author_justify:
  assumes "trace_to tr s"
  assumes "isAut' tr cid uid pid"
  shows "isAut s cid uid pid"
  using assms
proof (induction arbitrary: uid)
  case (empty s) thus ?case
    by (auto simp add: istate_def elim: isAut'.cases)
next
  case (step tr s a ou s')
  from step.prems
  show ?case
  proof (cases)
    case (creator _ _ pass s1 s2)
    hence [simp]: "a=Cact (cPaper cid uid pass pid s1 s2)" "ou=outOK" by simp_all
    from step.hyps show ?thesis
      by (auto simp add: c_defs)
  next
    case (co_author _ uid' _ _ pass)
    hence [simp]: "a=Cact (cAuthor cid uid' pass pid uid)" "ou=outOK" by simp_all
    from step.hyps show ?thesis
      by (auto simp add: c_defs)
  next
    case (irrelevant) with step.IH have AUT: "isAut s cid uid pid" by simp

    note roles_confIDs[OF â¹reach sâº AUT]
    with AUT â¹step s a = (ou, s')âº show ?thesis
      apply (cases a)
      subgoal for x1 apply (cases x1, auto simp: c_defs) [] .
      subgoal for x2 apply (cases x2, auto simp: u_defs) [] .
      subgoal for x3 apply (cases x3, auto simp: uu_defs) [] .
      by simp_all
  qed
qed

theorem isAut_eq: "trace_to tr s â¹ isAut s cid uid pid â· isAut' tr cid uid pid"
  (* "Trace-based equivalent of authorship" *)
  using justify_author author_justify
  by (blast)


subsection â¹Becoming a Conference Chairâº

inductive isChair' :: "(state,act,out) trans trace â confID â userID â bool" where
  creator: "â¦ trn=Trans _ (Cact (cConf cid uid _ _ _)) outOK _ â§
    â¹ isChair' (tr@[trn]) cid uid"
| add_chair: "â¦ isChair' tr cid uid'; trn = Trans _ (Cact (cChair cid uid' _ uid)) outOK _ â§
  â¹ isChair' (tr@[trn]) cid uid"
| irrelevant: "â¦isChair' tr cid uidâ§ â¹ isChair' (tr@[_]) cid uid"

lemma justify_chair:
  assumes "trace_to tr s"
  assumes "isChair s cid uid"
  shows "isChair' tr cid uid"
  using assms
proof (induction arbitrary: uid)
  case (empty s) thus ?case
    by (auto simp add: istate_def)
next
  case (step tr s a ou s')
  show ?case
  proof (cases "isChair s cid uid")
    case True with step.IH show ?thesis by (blast intro: isChair'.intros)
  next
    case False
    term cConf
    with step.hyps step.prems obtain
      pass s1 s2 uid' where
      "a=Cact (cConf cid uid pass s1 s2)
      â¨ (a=Cact (cChair cid uid' pass uid) â§ isChair s cid uid')"
      and [simp]: "ou=outOK"
      apply (cases a)
      subgoal for x1 apply (cases x1, auto simp add: c_defs) [] .
      subgoal for x2 apply (cases x2, auto simp add: u_defs) [] .
      subgoal for x3 apply (cases x3, auto simp add: uu_defs) [] .
      by simp_all
    thus ?thesis using step.IH
      apply (elim disjE)
      apply (rule isChair'.creator, auto) []
      apply (rule isChair'.add_chair, auto) []
      done
  qed
qed

lemma chair_justify:
  assumes "trace_to tr s"
  assumes "isChair' tr cid uid"
  shows "isChair s cid uid"
  using assms
proof (induction arbitrary: uid)
  case (empty s) thus ?case
    by (auto simp add: istate_def elim: isChair'.cases)
next
  case (step tr s a ou s')
  from step.prems
  show ?case
  proof (cases)
    case (creator _ _ pass s1 s2)
    hence [simp]: "a=Cact (cConf cid uid pass s1 s2)" "ou=outOK" by simp_all
    from step.hyps show ?thesis
      by (auto simp add: c_defs)
  next
    case (add_chair _ uid' _ _ pass)
    hence [simp]: "a=Cact (cChair cid uid' pass uid)" "ou=outOK" by simp_all
    from step.hyps show ?thesis
      by (auto simp add: c_defs)
  next
    case (irrelevant) with step.IH have CH: "isChair s cid uid" by simp

    from CH â¹step s a = (ou, s')âº show ?thesis
      apply (cases a)
      subgoal for x1 apply (cases x1, auto simp: c_defs) [] .
      subgoal for x2 apply (cases x2, auto simp: u_defs) [] .
      subgoal for x3 apply (cases x3, auto simp: uu_defs) [] .
      by simp_all
  qed
qed

theorem isChair_eq: "trace_to tr s â¹ isChair s cid uid = isChair' tr cid uid"
  (* "Trace-based equivalent of being a chair" *)
  using justify_chair chair_justify
  by (blast)


subsection â¹Committee Membershipâº

inductive isPC' :: "(state,act,out) trans trace â confID â userID â bool" where
  chair: "isChair' tr cid uid â¹ isPC' tr cid uid"
| add_com: "â¦ isChair' tr cid uid'; trn = Trans _ (Cact (cPC cid uid' _ uid)) outOK _ â§
  â¹ isPC' (tr@[trn]) cid uid"
| irrelevant: "â¦isPC' tr cid uidâ§ â¹ isPC' (tr@[_]) cid uid"

lemma justify_com:
  assumes "trace_to tr s"
  assumes "isPC s cid uid"
  shows "isPC' tr cid uid"
  using assms
proof (induction arbitrary: uid)
  case (empty s) thus ?case
    by (auto simp add: istate_def)
next
  case (step tr s a ou s')

  show ?case
  proof (cases "isPC s cid uid")
    case True with step.IH show ?thesis by (blast intro: isPC'.irrelevant)
  next
    case False note noPC = this
    show ?thesis proof (cases "isChair s' cid uid")
      case True thus ?thesis
        by (metis chair justify_chair step.hyps(1) step.hyps(4) trace_to.step)
    next
      case False note noChair=this
      from noPC noChair step.hyps step.prems obtain
        pass uid' where "(a=Cact (cPC cid uid' pass uid))"
        and "isChair s cid uid'"
        and [simp]: "ou=outOK"
        apply (cases a)
        subgoal for x1 apply (cases x1, auto simp add: c_defs) [] .
        subgoal for x2 apply (cases x2, auto simp add: u_defs) [] .
        subgoal for x3 apply (cases x3, auto simp add: uu_defs) [] .
        by simp_all
      thus ?thesis
        apply -
        apply (rule isPC'.add_com, auto simp: isChair_eq[OF â¹trace_to tr sâº]) []
        done
    qed
  qed
qed

lemma com_justify:
  assumes "trace_to tr s"
  assumes "isPC' tr cid uid"
  shows "isPC s cid uid"
  using assms
proof (induction arbitrary: uid)
  case (empty s) thus ?case
    by (auto simp add: istate_def elim!: isPC'.cases isChair'.cases)
next
  case (step tr s a ou s')
  from step.prems
  show ?case
  proof (cases)
    case chair thus ?thesis
      by (metis isChair_eq isChair_isPC step.hyps(1) step.hyps(3) step.hyps(4) trace_to.step)
  next
    case (add_com _ uid' _ _ pass)
    hence [simp]: "a=Cact (cPC cid uid' pass uid)" "ou=outOK" by simp_all
    from step.hyps show ?thesis
      by (auto simp add: c_defs)
  next
    case (irrelevant) with step.IH have COM: "isPC s cid uid" by simp

    from COM â¹step s a = (ou, s')âº show ?thesis
      apply (cases a)
      subgoal for x1 apply (cases x1, auto simp: c_defs) [] .
      subgoal for x2 apply (cases x2, auto simp: u_defs) [] .
      subgoal for x3 apply (cases x3, auto simp: uu_defs) [] .
      by simp_all
  qed
qed

theorem isPC_eq: "trace_to tr s â¹ isPC s cid uid = isPC' tr cid uid"
  (* "Trace-based equivalent of committee membership" *)
  using justify_com com_justify
  by (blast)


subsection â¹Being a Reviewerâº

inductive isRev' :: "(state,act,out) trans trace â confID â userID â paperID â bool" where
  add_rev: "â¦ isChair' tr cid uid'; trn = Trans _ (Cact (cReview cid uid' _ pid uid)) outOK _ â§
  â¹ isRev' (tr@[trn]) cid uid pid"
| irrelevant: "â¦isRev' tr cid uid pidâ§ â¹ isRev' (tr@[_]) cid uid pid"

lemma justify_rev:
  assumes "trace_to tr s"
  assumes "isRev s cid uid pid"
  shows "isRev' tr cid uid pid"
  using assms
proof (induction)
  case empty thus ?case
    by (auto simp add: istate_def isRev_def)
next
  case (step tr s a ou s')

  show ?case
  proof (cases "isRev s cid uid pid")
    case True with step.IH show ?thesis by (blast intro: isRev'.irrelevant)
  next
    case False note noRev = this
    with step.hyps step.prems obtain
      pass uid' where "(a=Cact (cReview cid uid' pass pid uid))"
      and "isChair s cid uid'"
      and [simp]: "ou=outOK"
      apply (cases a)
      subgoal for x1 apply (cases x1, auto simp add: c_defs isRev_def) [] .
      subgoal for x2 apply (cases x2, auto simp add: u_defs isRev_def) [] .
      subgoal for x3 apply (cases x3, auto simp add: uu_defs isRev_def) [] .
      by simp_all
    thus ?thesis
      apply -
      apply (rule isRev'.add_rev, auto simp: isChair_eq[OF â¹trace_to tr sâº]) []
      done
  qed
qed

lemma rev_justify:
  assumes "trace_to tr s"
  assumes "isRev' tr cid uid pid"
  shows "isRev s cid uid pid"
  using assms
proof (induction arbitrary: uid)
  case (empty s) thus ?case
    by (auto simp add: istate_def elim!: isRev'.cases)
next
  case (step tr s a ou s')
  from step.prems
  show ?case
  proof (cases)
    case (add_rev _ uid' _ _ pass)
    hence [simp]: "a=Cact (cReview cid uid' pass pid uid)" "ou=outOK" by simp_all
    from step.hyps show ?thesis
      by (auto simp add: c_defs isRev_def)
  next
    case (irrelevant) with step.IH have REV: "isRev s cid uid pid" by simp

    note roles_confIDs[OF step.hyps(2)]
    with REV â¹step s a = (ou, s')âº show ?thesis
      apply (cases a)
      subgoal for x1 apply (cases x1, auto simp: c_defs isRev_def) [] .
      subgoal for x2 apply (cases x2, auto simp: u_defs isRev_def) [] .
      subgoal for x3 apply (cases x3, auto simp: uu_defs isRev_def) [] .
      by simp_all
  qed
qed

theorem isRev_eq: "trace_to tr s â¹ isRev s cid uid pid = isRev' tr cid uid pid"
  (* "Trace-based equivalent of being a reviewer" *)
  using justify_rev rev_justify
  by (blast)



subsection "Conflicts"

fun irrev_conflict :: "userID â paperID â (state,act,out) trans â bool"
 (* "Transitions causing irrevokable conflicts" *)
where
  "irrev_conflict uid pid (Trans _ (Cact (cPaper _ uid' _ pid' _ _)) outOK _)
    â· uid'=uid â§ pid'=pid"
| "irrev_conflict uid pid (Trans _ (Cact (cAuthor _ _ _ pid' uid')) outOK _)
    â· uid'=uid â§ pid'=pid"
| "irrev_conflict uid pid _ â· False"

fun set_conflict :: "userID â paperID â (state,act,out) trans â bool"
  (* "Transitions setting conflict state, can be revoked by later reset-actions" *)
  where
  "set_conflict uid pid (Trans _ (Cact (cConflict _ _ _ pid' uid')) outOK _)
    â· uid'=uid â§ pid'=pid"
| "set_conflict uid pid (Trans _ (Uact (uPref _ uid' _ pid' Conflict)) outOK _)
    â· uid'=uid â§ pid'=pid"
| "set_conflict _ _ _ â· False"

fun reset_conflict :: "userID â paperID â (state,act,out)trans â bool"
  (* "Transitions re-setting conflict state, can be revoked by later set-actions" *)
  where
  "reset_conflict uid pid (Trans _ (Uact (uPref _ uid' _ pid' pr)) outOK _)
    â· uid'=uid â§ pid'=pid â§ prâ Conflict"
| "reset_conflict _ _ _ â· False"

definition conflict_trace :: "userID â paperID â (state,act,out) trans trace â bool"
  (* "Trace that causes a conflict: It contains either an irrevokable conflict action,
    or the last action concerning conflicts was set-conflict" *)
  where
  "conflict_trace uid pid tr â¡
  (âtrnâset tr. irrev_conflict uid pid trn)
â¨ (âtr1 trn tr2. tr=tr1@trn#tr2 â§
    set_conflict uid pid trn â§ (âtrnâset tr2. Â¬reset_conflict uid pid trn))"

lemma irrev_conflict_impl_author:
  assumes "trace_to tr s"
  assumes "âtrnâset tr. irrev_conflict uid pid trn"
  shows "âcid. isAut s cid uid pid"
  using assms
  apply induction
  apply (auto simp add: istate_def) []
  subgoal for _ _ a apply (cases a)
    subgoal for x1 apply (cases x1, auto simp: c_defs, (metis roles_confIDs)+) [] .
    subgoal for x2 apply (cases x2, auto simp: u_defs) [] .
    subgoal for x3 apply (cases x3, auto simp: uu_defs) [] .
    by simp_all
  done

lemma irrev_conflict_impl_conflict:
  assumes "trace_to tr s"
  assumes "âtrnâset tr. irrev_conflict uid pid trn"
  shows "pref s uid pid = Conflict"
  by (metis assms(1) assms(2) irrev_conflict_impl_author
    isAut_pref_Conflict reach_trace_to_conv)

lemma conflict_justify:
  assumes TR: "trace_to tr s"
  assumes "conflict_trace uid pid tr"
  shows "pref s uid pid = Conflict"
  using assms(2)
  unfolding conflict_trace_def
proof (cases rule: disjE[consumes 1, case_names irrev set])
  case irrev thus ?thesis by (simp add: irrev_conflict_impl_conflict[OF TR])
next
  case set
  then obtain tr1 trn tr2 where
    [simp]: "tr = tr1 @ trn # tr2" and
    SET: "set_conflict uid pid trn"
    and NRESET: "âtrnâset tr2. Â¬ reset_conflict uid pid trn"
    by blast

  from TR obtain s1 s2 a ou where
    [simp]: "trn = Trans s1 a ou s2" and
    TR1: "trace_to tr1 s1" and
    STEP: "step s1 a = (ou,s2)" and
    TR2: "trace_between s2 tr2 s"
    by (fastforce simp add: trace_to_ft trace_ft_simps)

  from STEP SET have "pref s2 uid pid = Conflict"
    apply (cases a)
      subgoal for x1 apply (cases x1, auto simp: c_defs) [] .
      subgoal for x2 apply (cases x2, auto simp: u_defs) []
        subgoal for _ x65 apply (cases x65, auto) [] .
        subgoal for _ _ _ x65 apply (cases x65, auto) [] .
        subgoal for _ _ _ x65 apply (cases x65, auto) [] . .
      by simp_all

  with TR2 NRESET show ?thesis
    apply induction
    subgoal by simp
    subgoal for _ _ _ a apply (cases a)
      subgoal for x1 apply (cases x1, auto simp: c_defs) [] .
      subgoal for x2 apply (cases x2, auto simp: u_defs) [] .
      subgoal for x3 apply (cases x3, auto simp: uu_defs) [] .
      by simp_all
    done
qed

lemma justify_conflict:
  assumes TR: "trace_to tr s"
  assumes "pref s uid pid = Conflict"
  shows "conflict_trace uid pid tr"
  using assms
proof induction
  case empty thus ?case by (auto simp add: istate_def)
next
  case (step tr s a ou s')

  let ?trn = "Trans s a ou s'"

  show ?case proof (cases "pref s uid pid = Conflict")
    case False
    with step.prems â¹step s a = (ou, s')âº
    have "irrev_conflict uid pid ?trn â¨ set_conflict uid pid ?trn"
      apply (cases a)
      subgoal for x1 apply (cases x1, auto simp: c_defs) [] .
      subgoal for x2 apply (cases x2, auto simp: u_defs) [] .
      subgoal for x3 apply (cases x3, auto simp: uu_defs) [] .
      by simp_all
    thus ?thesis
      unfolding conflict_trace_def by fastforce
  next
    case True with step.IH have CT: "conflict_trace uid pid tr" .

    from step.prems â¹step s a = (ou, s')âº have "Â¬reset_conflict uid pid ?trn"
      apply (cases a)
      subgoal by simp
      subgoal for x2 by (cases x2, auto simp: u_defs)
      by simp_all

    thus ?thesis using CT
      unfolding conflict_trace_def
      apply clarsimp
      by (metis rotate1.simps(2) set_ConsD set_rotate1)

  qed
qed

theorem conflict_eq:
  assumes "trace_to tr s"
  shows "pref s uid pid = Conflict â· conflict_trace uid pid tr"
  using assms conflict_justify justify_conflict by auto


subsection â¹Conference Phasesâº

fun is_uPhase where
  "is_uPhase cid (Trans _ (Uact (uConfA cid' _ _)) outOK _) â· cid'=cid"
| "is_uPhase cid (Trans _ (Uact (uPhase cid' _ _ _)) outOK _) â· cid'=cid"
| "is_uPhase _ _ â· False"

inductive phase' :: "(state,act,out) trans trace â confID â nat â bool" where
  initial: "phase' [] cid noPH"
| approve: "â¦phase' tr cid noPH; trn=Trans s (Uact (uConfA cid (voronkov s) _)) outOK _ â§
  â¹ phase' (tr@[trn]) cid setPH"
| advance: "â¦trn = (Trans _ (Uact (uPhase cid uid _ ph)) outOK _); isChair' tr cid uidâ§
  â¹ phase' (tr@[trn]) cid ph"
| irrelevant: "â¦phase' tr cid ph; Â¬is_uPhase cid trn â§ â¹ phase' (tr@[trn]) cid ph"

lemma justify_phase:
  assumes "trace_to tr s"
  assumes "phase s cid = ph"
  shows "phase' tr cid ph"
  using assms
proof (induction arbitrary: ph)
  case (empty s) thus ?case
    by (auto simp add: istate_def phase'.initial)
next
  case (step tr s a ou s')
  thus ?case
    apply (cases a)
    subgoal for x1 apply (cases x1, auto simp: c_defs intro: phase'.advance phase'.irrelevant) [] .
    subgoal for x2 apply (cases x2,
      auto
        simp: u_defs isChair_eq
        intro: phase'.advance phase'.irrelevant phase'.approve,
      (fastforce intro: phase'.approve phase'.irrelevant phase'.advance)+
    ) [] .

    subgoal for x3 apply (cases x3, auto simp: uu_defs intro: phase'.irrelevant) [] .
    by (auto intro: phase'.advance phase'.irrelevant)
qed

lemma phase_justify:
  assumes "trace_to tr s"
  assumes "phase' tr cid ph"
  shows "phase s cid = ph"
  using assms
proof (induction arbitrary: ph)
  case (empty s) thus ?case
    by (auto simp add: istate_def elim: phase'.cases)
next
  case (step tr s a ou s')
  from step.prems
  show ?case
  proof (cases)
    case (approve _ _ _ pass _)
    hence [simp]: "a=Uact (uConfA cid (voronkov s) pass)" "ou=outOK" "ph=setPH" by simp_all
    from step.hyps show ?thesis
      by (auto simp add: u_defs)
  next
    case (advance _ _ uid pass _ _)
    hence [simp]: "a=Uact (uPhase cid uid pass ph)" "ou=outOK" by simp_all
    from step.hyps show ?thesis
      by (auto simp add: u_defs)
  next
    case (irrelevant) with step.IH have PH: "phase s cid = ph" "Â¬ is_uPhase cid (Trans s a ou s')"
      by simp_all

    from PH â¹step s a = (ou, s')âº show ?thesis
    apply (cases a)
    subgoal for x1 apply (cases x1, auto simp: c_defs) [] .
    subgoal for x2 apply (cases x2, auto simp: u_defs) [] .
    subgoal for x3 apply (cases x3, auto simp: uu_defs) [] .
    by simp_all
  qed auto
qed

theorem phase_eq:
  assumes "trace_to tr s"
  shows "phase s cid = ph â· phase' tr cid ph"
  using assms phase_justify justify_phase by blast

end

Theory Prelim

Theory System_Specification

Theory Automation_Setup

Theory Safety_Properties

Theory Observation_Setup

Theory Paper_Intro

Theory Paper_Value_Setup

Theory Paper_Aut_PC

Theory Paper_Aut

Theory Paper_All

Theory Review_Intro

Theory Review_Value_Setup

Theory Review_RAut

Theory Review_RAut_NCPC

Theory Review_RAut_NCPC_PAut

Theory Review_All

Theory Discussion_Intro

Theory Discussion_Value_Setup

Theory Discussion_NCPC

Theory Discussion_All

Theory Decision_Intro

Theory Decision_Value_Setup

Theory Decision_NCPC

Theory Decision_NCPC_Aut

Theory Decision_All

Theory Reviewer_Assignment_Intro

Theory Reviewer_Assignment_Value_Setup

Theory Reviewer_Assignment_NCPC

Theory Reviewer_Assignment_NCPC_Aut

Theory Reviewer_Assignment_All

Theory Traceback_Properties

Theory All_BD_Security_Instances_for_CoCon